home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / gfa / scsbbs02 / scs_bbs.gfa (.txt) < prev   
Encoding:
GFA-BASIC Atari  |  1992-02-23  |  76.3 KB  |  4,146 lines
  1. ' ½ 1991-92 Jan Lever‚n. Fidonet, 2:203/203.9
  2. '
  3. ' Last Edit 920224
  4. '
  5. DEFFN komma$(a$)=TRIM$(MID$(a$,INSTR(a$,",")+1))
  6. DEFFN cd=EVEN(BTST(DPEEK(&HFFFA00),1))                ! Carrier Detect
  7. '
  8. scs$=@enviroment$("SCS=")
  9. version$="0.02"
  10. setupvars
  11. init_date
  12. read_bbs.cfg
  13. '
  14. ' --------------------------------------
  15. '
  16. '
  17. ' --- Main
  18. '
  19. oldhomedir$=@cwd$
  20. homedir$=@enviroment$("SCS=")
  21. ~@chd(homedir$)
  22. '
  23. last_ac$="Boot up"
  24. last_err$="None"
  25. DIM statusline$(9)
  26. IF EXIST(scs$+"conf\statline.bbs")
  27.   OPEN "i",#1,scs$+"conf\STATLINE.BBS"
  28.   RECALL #1,statusline$(),10,a%
  29.   CLOSE #1
  30. ENDIF
  31. '
  32. main
  33. ~@chd(oldhomedir$)
  34. EDIT
  35. '
  36. ' --- ... ---
  37. '
  38. > PROCEDURE main
  39.   PRINT "Initiating BBS..."
  40.   LOCAL t%,x%,y%,c&
  41.   sluta!=FALSE
  42.   c&=0
  43.   '
  44.   DO
  45.     baud$="???"
  46.   mailer:
  47.     old_dir$=@cwd$
  48.     ' mailer!=TRUE
  49.     DO WHILE mailer!
  50.       mailer_exit!=FALSE
  51.       e%=@run(shell$,"D:\MAILER.BAT")
  52.       PRINT " o Error ";e%;" detected from Mailer"
  53.       SELECT e%
  54.       CASE 0
  55.         mailer_exit!=TRUE
  56.         sluta!=TRUE
  57.       CASE 3
  58.         baud$="300"
  59.         mailer_exit!=TRUE
  60.       CASE 12
  61.         baud$="1200"
  62.         mailer_exit!=TRUE
  63.       CASE 20
  64.         ~@chd("B:\MAILER\")
  65.         e%=@run("PACK.TTP","-t -s PLL")
  66.       CASE 24
  67.         baud$="2400"
  68.         mailer_exit!=TRUE
  69.       CASE 30
  70.         ~@chd("B:\MAILER\")
  71.         e%=@run("IMPORT.TTP","-t")
  72.       CASE 48
  73.         baud$="4800"
  74.         mailer_exit!=TRUE
  75.       CASE 96
  76.         baud$="9600"
  77.         mailer_exit!=TRUE
  78.       CASE 128
  79.         baud$="38400"
  80.         mailer_exit!=TRUE
  81.       CASE 144
  82.         baud$="1440"
  83.         mailer_exit!=TRUE
  84.       CASE 192
  85.         baud$="19200"
  86.         mailer_exit!=TRUE
  87.       CASE 100 !Local
  88.         mailer_exit!=TRUE
  89.       DEFAULT
  90.         last_err$="Error "+STR$(e%)+" from Mailer"
  91.         mailer_exit!=TRUE
  92.       ENDSELECT
  93.     LOOP UNTIL mailer_exit!
  94.     ~@chd(old_dir$)
  95.     '
  96.     EXIT IF sluta!
  97.     '
  98.     @modem_stat
  99.     IF NOT dcd!
  100.       setup_modem
  101.     ENDIF
  102.   start:
  103.     t%=TIMER
  104.     rec%=0
  105.     IF NOT dcd!
  106.       modem(m.init1$)
  107.       t%=TIMER
  108.       '
  109.       ~@dfree("")
  110.       '
  111.       CLS
  112.       PRINT "Short break..."
  113.       REPEAT
  114.       UNTIL TIMER-t%=>400 !1.5 sek
  115.       modem(m.init2$)
  116.     ENDIF
  117.     '
  118.     hangup!=FALSE
  119.     local!=FALSE
  120.     CLR ioch#
  121.     '
  122.     s.msgs!=FALSE
  123.     s.dc!=FALSE
  124.     s.yell!=FALSE
  125.     login|=0
  126.     '
  127.   start1:
  128.     cursor(FALSE)
  129.     IF NOT dcd!
  130.       wait_screen
  131.     ENDIF
  132.     REPEAT
  133.       @modem_stat
  134.       IF INP?(2)
  135.         SETCOLOR 0,1
  136.         i$=UPPER$(CHR$(INP(2)))
  137.         IF INSTR("EFTLMUQ"+CHR$(165)+CHR$(225),i$)
  138.           PRINT "Off hook...";AT(1,14);
  139.           modem(m.busy$)
  140.         ENDIF
  141.         ioch#=2
  142.         SELECT i$
  143.         CASE "W"              !Test
  144.           CLS
  145.           e%=@run("D:\BIN\ENVTEST.TTP","Hej")
  146.           PRINT "Press any key"
  147.           ~INP(2)
  148.           GOTO start
  149.         CASE "E"
  150.           last_ac$="Message Editor"
  151.           PRINT "Running Message Editor..."
  152.           e%=@run(editor$,"")
  153.           GOTO start
  154.         CASE "F"
  155.           last_ac$="File Edit"
  156.           PRINT "File Edit..."
  157.           filemenu
  158.           GOTO start
  159.         CASE "L"
  160.           last_ac$="Local BBS"
  161.           PRINT "Lokal Login..."
  162.           local!=TRUE
  163.           baud$="0"
  164.         CASE "M"
  165.           last_ac$="Menu Edit"
  166.           PRINT "Menu Edit..."
  167.           local!=TRUE
  168.           ~@init_userfile(99)
  169.           rec%=1
  170.           get_user(99,rec%)
  171.           CLOSE #99
  172.           menueditor
  173.           GOTO start
  174.         CASE "U"
  175.           last_ac$="Useredit"
  176.           PRINT "User Edit..."
  177.           useredit
  178.           GOTO start
  179.         CASE "S"
  180.           GOTO mailer
  181.         CASE "T"
  182.           last_ac$="Text Editor"
  183.           PRINT "Running Text Editor..."
  184.           e%=@run(text_editor$,"")
  185.           GOTO start
  186.         CASE "Q"
  187.           last_ac$="Quick Login"
  188.           PRINT "Quick Login..."
  189.           ~@init_userfile(99)
  190.           login|=BSET(login|,0)
  191.           rec%=1
  192.           get_user(99,rec%)
  193.           local!=TRUE
  194.         CASE 165
  195.           last_ac$="Jump to Dos"
  196.           jump_to_dos
  197.           GOTO start
  198.         CASE 225
  199.           PRINT "Exit requested..."
  200.           sluta!=TRUE
  201.         CASE 226
  202.           CLS
  203.           PRINT
  204.           PRINT " p  Q  q   Quick login (only user 1)"
  205.           PRINT
  206.           PRINT " p  L  q   Local login"
  207.           PRINT
  208.           PRINT " p  U  q   User Editor"
  209.           PRINT
  210.           PRINT " p  F  q   File Editor"
  211.           PRINT
  212.           PRINT " p  M  q   Menu Editor"
  213.           PRINT
  214.           PRINT " p  E  q   External Mail-Editor."
  215.           PRINT
  216.           PRINT " p  T  q   External Text Editor"
  217.           PRINT
  218.           PRINT " p ALT q - p   J   q Jump to external dos-shell."
  219.           PRINT
  220.           PRINT " p UNDO q Quit"
  221.           PRINT
  222.           PRINT "Press ANY key"
  223.           ~INP(2)
  224.           GOTO start1
  225.         DEFAULT
  226.           PRINT "Asci ";ASC(i$);" has no function."
  227.         ENDSELECT
  228.       ELSE IF dcd!
  229.         ioch#=1
  230.         last_ac$="BBS"
  231.         PRINT " o Carrier detected!"
  232.         get_baud(baud|)
  233.         local!=FALSE
  234.       ELSE IF TIMER-t%>screensaver|*12000
  235.         t%=TIMER
  236.         SETCOLOR 0,c&
  237.         c&=ABS(NOT c&)
  238.       ELSE
  239.         PRINT AT(1,1);"p";TIME$;AT(71,1);DATE$;"q"
  240.         PRINT AT(1,14);
  241.       ENDIF
  242.     UNTIL dcd! OR local! OR sluta!
  243.     SETCOLOR 0,1
  244.     CLS
  245.     '
  246.     EXIT IF sluta!
  247.     '
  248.     login(login|)
  249.     mainmenu("top","")
  250.     '
  251.     after_bbs
  252.     '
  253.     REPEAT
  254.       IF INP?(1)
  255.         ~INP(1)
  256.       ENDIF
  257.       wait(5)
  258.     UNTIL INP?(1)=FALSE
  259.   LOOP
  260.   modem(m.reset$)
  261. RETURN
  262. > PROCEDURE wait_screen
  263.   CLS
  264.   a$="SCS BBS "+version$+" ½1991 Jan Lever‚n"
  265.   PRINT AT(1,1);"p";SPACE$(80);AT(40-(LEN(a$)/2),1);a$;"q"
  266.   a$="EVENTS"
  267.   PRINT AT(1,2);"p q";AT(1,9);"p q"
  268.   FOR i%=1 TO 6
  269.     PRINT AT(1,i%+2);"p";MID$(a$,i%,1);"q"
  270.   NEXT i%
  271.   FOR i%=0 TO 5
  272.     PRINT AT(4,i%+3);SPACE$(ABS(i%<10));i%;":00 _____"
  273.     PRINT AT(16,i%+3);SPACE$(ABS(i%+6<10));i%+6;":00 _____"
  274.     PRINT AT(28,i%+3);i%+12;":00 _____"
  275.     PRINT AT(40,i%+3);i%+18;":00 _____"
  276.   NEXT i%
  277.   mem%=INT(FRE(0)/1024)
  278.   PRINT AT(58,2);"p";SPACE$(23);AT(60,2);"Mem: ";SPACE$(5-LEN(STR$(mem%)));mem%;
  279.   FOR i%=1 TO 7
  280.     PRINT AT(58,i%+2);SPACE$(23);AT(62,2+i%);CHR$(i%+64);": ";
  281.     IF free%(i%)>-1
  282.       PRINT SPACE$(5-LEN(STR$(free%(i%))));free%(i%);
  283.     ELSE
  284.       PRINT "-----";
  285.     ENDIF
  286.   NEXT i%
  287.   FOR i%=8 TO 16
  288.     PRINT AT(72,-6+i%);CHR$(i%+64);": ";
  289.     IF free%(i%)>-1
  290.       PRINT SPACE$(5-LEN(STR$(free%(i%))));free%(i%);
  291.     ELSE
  292.       PRINT "-----";
  293.     ENDIF
  294.   NEXT i%
  295.   PRINT AT(58,10);SPACE$(14);AT(80,10);" q";
  296.   a$="FREE"
  297.   FOR i%=1 TO 4
  298.     PRINT AT(60,i%+3);"p";MID$(a$,i%,1);"q"
  299.   NEXT i%
  300.   IF LEN(cur_ac$)=0
  301.     cur_ac$="Waiting for Calls"
  302.   ENDIF
  303.   PRINT AT(1,10);"p";SPACE$(58);AT(1,10);"Activity: q"
  304.   PRINT AT(1,11);"Last    : ";last_ac$
  305.   PRINT AT(1,12);"Current : ";cur_ac$
  306.   PRINT AT(1,13);"Last Err: ";last_err$
  307.   PRINT AT(1,15);"p Name                  On    Off   Sec Cred   Msg  Calls Dwn_Td/Dwn/Up  Flags   q"
  308.   FOR i%=0 TO 9
  309.     PRINT AT(1,i%+16);;statusline$(i%);
  310.   NEXT i%
  311.   PRINT AT(1,14);
  312. RETURN
  313. '
  314. ' --- User Editor ---
  315. '
  316. > PROCEDURE useredit
  317.   local!=TRUE
  318.   l%=@init_userfile(99)
  319.   get_user(99,1)
  320.   CLOSE #99
  321.   l%=@init_t.userfile(99)
  322.   rec%=0
  323.   DO
  324.     INC rec%
  325.     IF rec%>l%
  326.       rec%=l%
  327.     ELSE IF rec%<1
  328.       rec%=1
  329.     ENDIF
  330.     get_t.user(99,rec%)
  331.   sysedit:
  332.     sys_setupmenu
  333.     send(cr$+cr$+"(E)dit (N)ext (P)revious (G)oto (Q)uit")
  334.     getchr(ch$)
  335.     SELECT UPPER$(ch$)
  336.     CASE "E"
  337.       cursor(TRUE)
  338.       done!=FALSE
  339.       REPEAT
  340.         sys_setupmenu
  341.         sys_edituser
  342.       UNTIL done!
  343.       cursor(FALSE)
  344.       GOTO sysedit
  345.     CASE "N"
  346.       ' next
  347.     CASE "P"
  348.       SUB rec%,2
  349.       IF rec%<0
  350.         rec%=0
  351.       ENDIF
  352.     CASE "G"
  353.       a$=STR$(rec%)
  354.       send(cr$+"Goto Number? (1 - "+STR$(l%)+"):")
  355.       input(2,5,32,a$)
  356.       IF VAL(a$)>l%
  357.         a$=STR$(l%)
  358.       ELSE IF VAL(a$)<1
  359.         a$="1"
  360.       ENDIF
  361.       rec%=VAL(a$)-1
  362.     CASE "Q"
  363.       EXIT IF TRUE
  364.     DEFAULT
  365.       GOTO sysedit
  366.     ENDSELECT
  367.   LOOP UNTIL hangup!
  368.   local!=FALSE
  369.   CLOSE #99
  370. RETURN
  371. > PROCEDURE sys_setupmenu
  372.   clr
  373.   send("Setup for user "+STR$(rec%)+" of "+STR$(l%)+cr$)
  374.   send(cr$+"0) Name         : "+t.user$)
  375.   send(cr$+"1) Alias        : "+t.alias$)
  376.   send(cr$+"2) City         : "+t.city$)
  377.   send(cr$+"3) Password     : "+t.pass$)
  378.   send(cr$+"4) Phone        : "+t.phone$)
  379.   send(cr$+"5) Last On      : "+LEFT$(t.last_time$,2)+":"+MID$(t.last_time$,3)+" "+t.last_date$)
  380.   send(cr$+"6) Attribut     : ")
  381.   IF BTST(t.attribut|,0)
  382.     send("CLS ")
  383.   ENDIF
  384.   IF BTST(t.attribut|,1)
  385.     send("More ")
  386.   ENDIF
  387.   IF BTST(t.attribut|,7)
  388.     send("Deleted")
  389.   ENDIF
  390.   send(cr$+"7) ScreenLenght : "+STR$(t.screenlenght|))
  391.   flag$=BIN$(t.flags%,32)
  392.   send(cr$+"8) Flags        : ")
  393.   send("A: "+LEFT$(flag$,8))
  394.   send(" B: "+MID$(flag$,9,8))
  395.   send(" C: "+MID$(flag$,17,8))
  396.   send(" D: "+MID$(flag$,25))
  397.   send(cr$+"9) Credits      : "+STR$(t.credits&))
  398.   send(cr$+"A) Posted Msgs  : "+STR$(t.posted_msgs&))
  399.   send(cr$+"B) Graphics     : ")
  400.   SELECT t.graphics|
  401.   CASE 0
  402.     send("Ascii")
  403.   CASE 1
  404.     send("VT52 Mono")
  405.   CASE 2
  406.     send("VT52 Colour")
  407.   CASE 3
  408.     send("VT52 Standard")
  409.   CASE 4
  410.     send("Ansi")
  411.   ENDSELECT
  412.   send(cr$+"C) Level        : "+STR$(t.level|))
  413.   send(cr$+"D) Calls        : "+STR$(t.calls&))
  414.   send(cr$+"E) Upload       : "+STR$(t.uploads&)+" of "+STR$(t.upl_kb&)+"Kb")
  415.   send(cr$+"F) Downloads    : "+STR$(t.downloads&)+" of "+STR$(t.down_kb&)+"Kb")
  416.   send(cr$+"G) LastMSG      : "+STR$(t.lastmsg&))
  417.   send(cr$+"H) LastFile     : "+STR$(t.lastfile&))
  418.   send(cr$+"I) Charset      : "+STR$(t.charset|))
  419.   send(cr$+"J) Today        : "+STR$(t.down_today&)+" Kb Download, "+STR$(t.minutes_today&)+" Minutes used.")
  420. RETURN
  421. > PROCEDURE sys_edituser
  422.   send(cr$+cr$+"(S) Save user (Q) Abort edit")
  423.   send(cr$+"Choose 0-9 A-J S,Q >")
  424.   CLR ch$
  425.   menu("0123456789ABCDEFGHIJSQ"+CHR$(13),ch$)
  426.   SELECT ch$
  427.   CASE "0"
  428.     clr
  429.     send(cr$+"Please enter your full name: ")
  430.     input(2,35,32,t.user$)
  431.   CASE "1"
  432.     clr
  433.     send(cr$+"Please enter your alias: ")
  434.     input(2,15,32,t.alias$)
  435.   CASE "2"
  436.     clr
  437.     send(cr$+"Please enter City:")
  438.     input(2,15,32,t.city$)
  439.   CASE "3"
  440.     clr
  441.     send(cr$+"Please enter Password: ")
  442.     input(3,15,32,t.pass$)
  443.   CASE "4"
  444.     clr
  445.     send(cr$+"Please enter phonenumber:")
  446.     input(1,15,32,t.phone$)
  447.   CASE "5"
  448.     ' laston
  449.     a$=LEFT$(t.last_time$,2)+":"+MID$(t.last_time$,3)
  450.     send(cr$+"Enter Lasttime (HH:MM):")
  451.     input(1,5,32,a$)
  452.     IF MID$(a$,3,1)=":"
  453.       t.last_time$=LEFT$(a$,2)+RIGHT$(a$,2)
  454.     ENDIF
  455.     a$=t.last_date$
  456.     send(cr$+"Enter Last Date (YYMMDD):")
  457.     input(1,6,32,a$)
  458.     t.last_date$=a$
  459.   CASE "6"
  460.     clr
  461.     t.attribut|=0
  462.     ' Bit 0 = CLS
  463.     ' Bit 1 = More
  464.     ' Bit 7 = Deleted
  465.     clr
  466.     CLR ch$
  467.     send(cr$+cr$+"Do you want Clear-Screen codes to be sent (Y/n) ?")
  468.     menu("YN"+CHR$(13),ch$)
  469.     t.attribut|=BCLR(t.attribut|,0)
  470.     IF ch$<>"N"
  471.       ch$="Y"
  472.       t.attribut|=BSET(t.attribut|,0)
  473.     ENDIF
  474.     send(ch$)
  475.     CLR ch$
  476.     send(cr$+cr$+"Do you want Pause if text is longer then screen (Y/n) ?")
  477.     menu("YN"+CHR$(13),ch$)
  478.     IF ch$<>"N"
  479.       ch$="Y"
  480.       t.attribut|=BSET(t.attribut|,1)
  481.     ELSE
  482.       t.attribut|=BCLR(t.attribut|,1)
  483.     ENDIF
  484.     send(ch$)
  485.     CLR ch$
  486.     send(cr$+cr$+"Delete this user (y/N) ?")
  487.     menu("YN"+CHR$(13),ch$)
  488.     IF ch$<>"Y"
  489.       ch$="N"
  490.       t.attribut|=BCLR(t.attribut|,7)
  491.     ELSE
  492.       t.attribut|=BSET(t.attribut|,7)
  493.     ENDIF
  494.     send(ch$)
  495.   CASE "7"
  496.     clr
  497.     a$=STR$(t.screenlenght|)
  498.     send(cr$+"Enter lenght of your screen (0-255):")
  499.     input(4,3,32,a$)
  500.     IF VAL(a$)>255
  501.       t.screenlenght|=255
  502.     ELSE IF VAL(a$)<=5
  503.       t.screenlenght|=5
  504.     ELSE
  505.       t.screenlenght|=VAL(a$)
  506.     ENDIF
  507.   CASE "8"
  508.     clr
  509.     flag$=BIN$(t.flags%,32)
  510.     send(cr$+"                              A       B       C       D")
  511.     send(cr$+"                              12345678123456781234567812345678")
  512.     send(cr$+"Toggle flags between 0 and 1: ")
  513.     input(4,32,ASC("0"),flag$)
  514.     t.flags%=VAL("&X"+flag$)
  515.   CASE "9"
  516.     clr
  517.     credit$=STR$(t.credits&)
  518.     send(cr$+"Enter Credits (0-32767):")
  519.     input(4,5,32,credit$)
  520.     IF VAL(credit$)>32767
  521.       t.credits&=32767
  522.     ELSE IF VAL(credit$)<=0
  523.       t.credits&=0
  524.     ELSE
  525.       t.credits&=VAL(credit$)
  526.     ENDIF
  527.   CASE "A"
  528.     clr
  529.     a$=STR$(t.posted_msgs&)
  530.     send(cr$+"Enter Posted Msgs (0-32767):")
  531.     input(4,5,32,a$)
  532.     IF VAL(a$)>32767
  533.       t.posted_msgs&=32767
  534.     ELSE IF VAL(a$)<=0
  535.       t.posted_msgs&=0
  536.     ELSE
  537.       t.posted_msgs&=VAL(a$)
  538.     ENDIF
  539.   CASE "B"
  540.     clr
  541.     send(cr$+"Choose some graphics:"+cr$)
  542.     send(cr$+" 1) Ascii      (Works for everyone)")
  543.     send(cr$+" 2) VT52 mono  (Atari ST Only)")
  544.     send(cr$+" 3) VT52 color (Atari ST Only")
  545.     send(cr$+" 4) VT52       (Standard, None Atari's VT52)")
  546.     send(cr$+" 5) Ansi       (PC Compatible graphics)")
  547.     send(cr$+"Your choice:")
  548.     CLR ch$
  549.     menu("12345"+CHR$(13),ch$)
  550.     IF VAL(ch$)>0
  551.       t.graphics|=VAL(ch$)-1
  552.     ELSE
  553.       t.graphics|=0
  554.     ENDIF
  555.     send(ch$)
  556.   CASE "C"
  557.     clr
  558.     a$=STR$(t.level|)
  559.     send(cr$+"Enter Level (0-255):")
  560.     input(4,3,32,a$)
  561.     IF VAL(a$)>255
  562.       t.level|=255
  563.     ELSE IF VAL(a$)<=0
  564.       t.level|=0
  565.     ELSE
  566.       t.level|=VAL(a$)
  567.     ENDIF
  568.   CASE "D"
  569.     clr
  570.     a$=STR$(t.calls&)
  571.     send(cr$+"Enter Calls (0-32767):")
  572.     input(4,5,32,a$)
  573.     IF VAL(a$)>32767
  574.       t.calls&=32767
  575.     ELSE IF VAL(a$)<=0
  576.       t.calls&=0
  577.     ELSE
  578.       t.calls&=VAL(a$)
  579.     ENDIF
  580.   CASE "E"
  581.     clr
  582.     a$=STR$(t.uploads&)
  583.     send(cr$+"Enter Number of Uploads (0-32767):")
  584.     input(4,5,32,a$)
  585.     IF VAL(a$)>32767
  586.       t.uploads&=32767
  587.     ELSE IF VAL(a$)<=0
  588.       t.uploads&=0
  589.     ELSE
  590.       t.uploads&=VAL(a$)
  591.     ENDIF
  592.     a$=STR$(t.upl_kb&)
  593.     send(cr$+"Enter Uploaded KB (0-32767):")
  594.     input(4,5,32,a$)
  595.     IF VAL(a$)>32767
  596.       t.upl_kb&=32767
  597.     ELSE IF VAL(a$)<=0
  598.       t.upl_kb&=0
  599.     ELSE
  600.       t.upl_kb&=VAL(a$)
  601.     ENDIF
  602.   CASE "F"
  603.     clr
  604.     a$=STR$(t.downloads&)
  605.     send(cr$+"Enter Number of Downloads (0-32767):")
  606.     input(4,5,32,a$)
  607.     IF VAL(a$)>32767
  608.       t.downloads&=32767
  609.     ELSE IF VAL(a$)<=0
  610.       t.downloads&=0
  611.     ELSE
  612.       t.downloads&=VAL(a$)
  613.     ENDIF
  614.     a$=STR$(t.down_kb&)
  615.     send(cr$+"Enter Downloaded KB (0-32767):")
  616.     input(4,5,32,a$)
  617.     IF VAL(a$)>32767
  618.       t.down_kb&=32767
  619.     ELSE IF VAL(a$)<=0
  620.       t.down_kb&=0
  621.     ELSE
  622.       t.down_kb&=VAL(a$)
  623.     ENDIF
  624.   CASE "G"
  625.     clr
  626.     a$=STR$(t.lastmsg&)
  627.     send(cr$+"Enter LastMSG (0-32767):")
  628.     input(4,5,32,a$)
  629.     IF VAL(a$)>32767
  630.       t.lastmsg&=32767
  631.     ELSE IF VAL(a$)<=0
  632.       t.lastmsg&=0
  633.     ELSE
  634.       t.lastmsg&=VAL(a$)
  635.     ENDIF
  636.   CASE "H"
  637.     clr
  638.     a$=STR$(t.lastfile&)
  639.     send(cr$+"Enter Lastfile (0-32767):")
  640.     input(4,5,32,a$)
  641.     IF VAL(a$)>32767
  642.       t.lastfile&=32767
  643.     ELSE IF VAL(a$)<=0
  644.       t.lastfile&=0
  645.     ELSE
  646.       t.lastfile&=VAL(a$)
  647.     ENDIF
  648.   CASE "I"
  649.     clr
  650.     a$=STR$(t.charset|)
  651.     send(cr$+"Enter Charset (0-255):")
  652.     input(4,3,32,a$)
  653.     IF VAL(a$)>255
  654.       t.charset|=255
  655.     ELSE IF VAL(a$)<=0
  656.       t.charset|=0
  657.     ELSE
  658.       t.charset|=VAL(a$)
  659.     ENDIF
  660.   CASE "J"
  661.     clr
  662.     a$=STR$(t.down_today&)
  663.     send(cr$+"Enter KB downloaded today (0-32767):")
  664.     input(4,5,32,a$)
  665.     IF VAL(a$)>32767
  666.       t.down_today&=32767
  667.     ELSE IF VAL(a$)<=0
  668.       t.down_today&=0
  669.     ELSE
  670.       t.down_today&=VAL(a$)
  671.     ENDIF
  672.     a$=STR$(t.minutes_today&)
  673.     send(cr$+"Enter minutes used today (0-32767):")
  674.     input(4,5,32,a$)
  675.     IF VAL(a$)>32767
  676.       t.minutes_today&=32767
  677.     ELSE IF VAL(a$)<=0
  678.       t.minutes_today&=0
  679.     ELSE
  680.       t.minutes_today&=VAL(a$)
  681.     ENDIF
  682.   CASE "S"
  683.     ' Save
  684.     put_t.user(99,rec%)
  685.     done!=TRUE
  686.   CASE "Q"
  687.     ' Abort
  688.     done!=TRUE
  689.   ENDSELECT
  690. RETURN
  691. > PROCEDURE get_t.user(channel%,rec%)
  692.   GET #channel%,rec%
  693.   t.user$=CHAR{V:tu.user$}
  694.   t.city$=CHAR{V:tu.city$}
  695.   t.alias$=CHAR{V:tu.alias$}
  696.   t.pass$=CHAR{V:tu.pass$}
  697.   t.phone$=CHAR{V:tu.phone$}
  698.   t.last_time$=tu.last_time$
  699.   t.last_date$=tu.last_date$
  700.   t.attribut|=tu.attribut|
  701.   t.screenlenght|=tu.screenlenght|
  702.   t.flags%=tu.flags%
  703.   t.credits&=tu.credits&
  704.   t.posted_msgs&=tu.posted_msgs&
  705.   t.graphics|=tu.graphics|
  706.   t.level|=tu.level|
  707.   t.calls&=tu.calls&
  708.   t.uploads&=tu.uploads&
  709.   t.downloads&=tu.downloads&
  710.   t.upl_kb&=tu.upl_kb&
  711.   t.down_kb&=tu.down_kb&
  712.   t.down_today&=tu.down_today&
  713.   t.minutes_today&=tu.minutes_today&
  714.   t.lastfile&=tu.lastfile&
  715.   t.lastmsg&=tu.lastmsg&
  716.   t.charset|=tu.charset|
  717. RETURN
  718. > PROCEDURE put_t.user(channel%,rec%)
  719.   LSET tu.user$=t.user$+CHR$(0)
  720.   LSET tu.city$=t.city$+CHR$(0)
  721.   LSET tu.alias$=t.alias$+CHR$(0)
  722.   LSET tu.pass$=t.pass$+CHR$(0)
  723.   LSET tu.phone$=t.phone$+CHR$(0)
  724.   LSET tu.last_time$=t.last_time$+CHR$(0)
  725.   LSET tu.last_date$=t.last_date$+CHR$(0)
  726.   tu.attribut|=t.attribut|
  727.   tu.screenlenght|=t.screenlenght|
  728.   tu.flags%=t.flags%
  729.   tu.credits&=t.credits&
  730.   tu.posted_msgs&=t.posted_msgs&
  731.   tu.graphics|=t.graphics|
  732.   tu.level|=t.level|
  733.   tu.calls&=t.calls&
  734.   tu.uploads&=t.uploads&
  735.   tu.downloads&=t.downloads&
  736.   tu.upl_kb&=t.upl_kb&
  737.   tu.down_kb&=t.down_kb&
  738.   tu.down_today&=t.down_today&
  739.   tu.minutes_today&=t.minutes_today&
  740.   tu.lastfile&=t.lastfile&
  741.   tu.lastmsg&=t.lastmsg&
  742.   tu.charset|=t.charset|
  743.   PUT #channel%,rec%
  744. RETURN
  745. '
  746. ' --- File Editor ---
  747. '
  748. > PROCEDURE filemenu
  749.   local!=TRUE
  750.   l%=@init_userfile(99)
  751.   get_user(99,1)
  752.   CLOSE #99
  753.   '  clr
  754.   ' filearea
  755.   DO
  756.     clr
  757.     send("1. Edit Files.dat"+cr$)
  758.     send("2. Mark files.dat"+cr$)
  759.     send("3. Pack Files.dat"+cr$)
  760.     send(cr$+"Q. Quit")
  761.     CLR ch$
  762.     menu("123Q",ch$)
  763.     ON VAL(ch$) GOSUB fileedit,mark_files.dat,pack_files.dat
  764.   LOOP UNTIL ch$="Q"
  765. RETURN
  766. > PROCEDURE fileedit
  767.   IF NOT EXIST(file_path$+"FILES.BBS")
  768.     create_files.bbs(file_path$)
  769.   ENDIF
  770.   lfd%=@init_files.dat(file_path$)
  771.   @files.dat(file_path$)
  772.   CLOSE #16
  773. RETURN
  774. > PROCEDURE create_files.bbs(path$)
  775. RETURN
  776. > PROCEDURE files.dat(path$)
  777.   clr
  778.   OPEN "I",#1,file_path$+"FILES.BBS"
  779.   REPEAT
  780.     fexist!=FALSE
  781.     LINE INPUT #1,a$
  782.     IF INSTR(" -/+=",LEFT$(a$))
  783.     ELSE
  784.       IF LEN(a$)=0
  785.         '
  786.       ELSE IF INSTR(a$," ")
  787.         file$=UPPER$(LEFT$(a$,INSTR(a$," ")-1))
  788.         desc$=MID$(a$,INSTR(a$," ")+1)
  789.         a$=file$+SPACE$(13-LEN(file$))
  790.         a$=a$+" "+@files$(file_path$+file$)+desc$
  791.         a$=@file_wrap$(a$)
  792.         clr
  793.         send(a$+cr$)
  794.         FOR i%=1 TO lfd%
  795.           get_files.dat(i%)
  796.           exist!=(ffilename$=file$)
  797.           EXIT IF exist!
  798.         NEXT i%
  799.         frec%=i%
  800.         IF exist!
  801.           send(cr$+"Number  : "+STR$(fnumber&))
  802.           send(cr$+"Uploader: "+fuploader$)
  803.           send(cr$+"Counter : "+STR$(fcounter&))
  804.           send(cr$+"Attribut: ")
  805.           IF BTST(fdelete|,0)
  806.             send("Deleted")
  807.           ELSE
  808.             send("Nothing")
  809.           ENDIF
  810.           send(cr$+cr$+"Change Anything? (y/N) ")
  811.           CLR ch$
  812.           menu("YN"+CHR$(13),ch$)
  813.           IF ch$="Y"
  814.             change_files.dat(frec%,file$,fuploader$,fcounter&,fnumber&,fdelete|)
  815.           ENDIF
  816.           send(cr$+cr$)
  817.         ELSE
  818.           send(cr$+"Files.dat entry Doesn't exist...")
  819.           INC fnumber&
  820.           frec%=LOF(#16)/54+1
  821.           change_files.dat(frec%,file$,"",0,fnumber&,FALSE)
  822.         ENDIF
  823.       ENDIF
  824.     ENDIF
  825.   UNTIL EOF(#1)
  826.   CLOSE #1
  827.   '
  828.   send(cr$+cr$+"Press <RETURN>..."+CHR$(1))
  829. RETURN
  830. > PROCEDURE change_files.dat(frec%,ffilename$,fuploader$,fcounter&,fnumber&,fdelete|)
  831.   a$=fuploader$
  832.   IF a$=""
  833.     a$="Sysop"
  834.   ENDIF
  835.   send(cr$+"Uploader: ")
  836.   input(2,35,32,a$)
  837.   fuploader$=a$
  838.   '
  839.   a$=STR$(fcounter&)
  840.   send(cr$+"Counter : ")
  841.   input(2,15,32,a$)
  842.   IF VAL(a$)>32767
  843.     a$="32767"
  844.   ELSE IF VAL(a$)<0
  845.     a$="0"
  846.   ENDIF
  847.   fcounter&=VAL(a$)
  848.   '
  849.   CLR ch$
  850.   send(cr$+cr$+"Delete (y/N) ?")
  851.   menu("YN"+CHR$(13),ch$)
  852.   fdelete|=0
  853.   IF ch$="Y"
  854.     fdelete|=BSET(fdelete|,0)
  855.   ENDIF
  856.   send(ch$+cr$)
  857.   '
  858.   put_files.dat(frec%)
  859. RETURN
  860. > PROCEDURE get_files.dat(frec%)
  861.   IF LOF(#16)
  862.     GET #16,frec%
  863.     fuploader$=CHAR{V:f.fuploader$}
  864.     ffilename$=CHAR{V:f.ffilename$}
  865.     fcounter&=f.fcounter&
  866.     fnumber&=f.fnumber&
  867.     fdelete|=f.fdelete|
  868.   ENDIF
  869. RETURN
  870. > PROCEDURE put_files.dat(frec%)
  871.   LSET f.fuploader$=fuploader$+CHR$(0)
  872.   LSET f.ffilename$=ffilename$+CHR$(0)
  873.   f.fcounter&=fcounter&
  874.   f.fnumber&=fnumber&
  875.   f.fdelete|=fdelete|
  876.   PUT #16,frec%
  877. RETURN
  878. '
  879. > PROCEDURE mark_files.dat
  880.   clr
  881.   '
  882.   lfd%=@init_files.dat(file_path$)
  883.   '
  884.   FOR i%=1 TO lfd%
  885.     get_files.dat(i%)
  886.     exist!=EXIST(file_path$+ffilename$)
  887.     IF BTST(fdelete|,0)
  888.       send("Deleted: "+STR$(fnumber&)+". ")
  889.       send(ffilename$+", ")
  890.       send(fuploader$+".")
  891.       IF exist!
  892.         send(" EXISTING FILE!!!")
  893.       ENDIF
  894.     ELSE
  895.       send("Active : "+STR$(fnumber&)+". ")
  896.       send(ffilename$+", ")
  897.       send(fuploader$+".")
  898.       IF NOT exist!
  899.         send(" NONE EXISTING FILE!!!")
  900.       ENDIF
  901.     ENDIF
  902.     CLR ch$
  903.     menu("DU"+CHR$(13),ch$)
  904.     IF ch$="D"
  905.       fdelete|=BSET(fdelete|,0)
  906.       send(" p Delete q"+cr$)
  907.     ELSE IF ch$="U"
  908.       fdelete|=BCLR(fdelete|,0)
  909.       send(" p Undelete q"+cr$)
  910.     ELSE
  911.       send(cr$)
  912.     ENDIF
  913.     put_files.dat(i%)
  914.     '
  915.   NEXT i%
  916.   CLOSE #16
  917. RETURN
  918. > PROCEDURE pack_files.dat
  919.   LOCAL tmp.fuploader$,tmp.ffilename$,tmp.fcounter&
  920.   LOCAL tmp.fnumber&,tmp.fdelete|
  921.   '
  922.   clr
  923.   '
  924.   lfd%=@init_files.dat(file_path$)
  925.   '
  926.   IF EXIST(file_path$+"FILES.TMP")
  927.     KILL file_path$+"FILES.TMP"
  928.   ENDIF
  929.   OPEN "R",#17,file_path$+"FILES.TMP",54
  930.   FIELD #17,36 AS tmp.fuploader$,13 AS tmp.ffilename$,2 AT(*tmp.fcounter&)
  931.   FIELD #17,2 AT(*tmp.fnumber&),1 AT(*tmp.fdelete|)
  932.   '
  933.   FOR i%=1 TO lfd%
  934.     get_files.dat(i%)
  935.     exist!=EXIST(file_path$+ffilename$)
  936.     IF BTST(fdelete|,0)
  937.       send("Delete: "+STR$(fnumber&)+". ")
  938.       send(ffilename$+", ")
  939.       send(fuploader$+".")
  940.       IF exist!
  941.         send(" EXISTING FILE!!!"+cr$)
  942.       ELSE
  943.         send(cr$)
  944.       ENDIF
  945.     ELSE
  946.       send("Keep  : "+STR$(fnumber&)+". ")
  947.       send(ffilename$+", ")
  948.       send(fuploader$+".")
  949.       IF exist!
  950.         send(cr$)
  951.       ELSE
  952.         send(" NONE EXISTING FILE!!!"+cr$)
  953.       ENDIF
  954.       LSET tmp.fuploader$=fuploader$+CHR$(0)
  955.       LSET tmp.ffilename$=ffilename$+CHR$(0)
  956.       tmp.fcounter&=fcounter&
  957.       tmp.fnumber&=fnumber&
  958.       tmp.fdelete|=fdelete|
  959.       PUT #17
  960.     ENDIF
  961.   NEXT i%
  962.   CLOSE #16
  963.   CLOSE #17
  964.   IF EXIST(file_path$+"F_DAT.BAK")
  965.     KILL file_path$+"F_DAT.BAK"
  966.   ENDIF
  967.   NAME file_path$+"FILES.DAT" AS file_path$+"F_DAT.BAK"
  968.   NAME file_path$+"FILES.TMP" AS file_path$+"FILES.DAT"
  969. RETURN
  970. '
  971. ' --- Menu Editor ---
  972. '
  973. > PROCEDURE menueditor
  974.   LOCAL a$,m.string$,e%,a|
  975.   '
  976.   DO
  977.     ~FSETDTA(BASEPAGE+128)
  978.     e%=FSFIRST(menu_path$+"*.MNU",-1)
  979.     m.string$=""
  980.     DO UNTIL e%
  981.       a|=PEEK(BASEPAGE+128+21)     !Attribut
  982.       IF (NOT BTST(a|,1)) AND (NOT BTST(a|,2)) AND (NOT BTST(a|,3)) AND (NOT BTST(a|,4))
  983.         a$=CHAR{BASEPAGE+158}
  984.         m.string$=m.string$+LEFT$(a$,INSTR(a$,".")-1)+", "
  985.       ENDIF
  986.       e%=FSNEXT()
  987.     LOOP
  988.     m.string$=LEFT$(m.string$,LEN(m.string$)-2)+"."
  989.     wrap(m.string$)
  990.     clr
  991.     send("Menus on disk:"+cr$)
  992.     send(cr$+m.string$)
  993.     send(cr$+cr$+"(E)dit menu (Q)uit")
  994.     CLR ch$
  995.     menu("EQ",ch$)
  996.     IF ch$="E"
  997.       m.get_name
  998.     ENDIF
  999.   LOOP UNTIL ch$="Q"
  1000. RETURN
  1001. > PROCEDURE m.get_name
  1002.   send(cr$+"Please name of menu you want to edit: ")
  1003.   CLR m.name$
  1004.   input(2,8,32,m.name$)
  1005.   IF LEN(m.name$)
  1006.     IF EXIST(menu_path$+m.name$+".MNU")
  1007.       m.edit(m.name$,TRUE)
  1008.     ELSE
  1009.       send(cr$+m.name$+" doesn't exist, create? (y/N)")
  1010.       CLR ch$
  1011.       menu("YN"+CHR$(13),ch$)
  1012.       IF ch$="Y"
  1013.         m.edit(menu_path$+m.name$+".MNU",FALSE)
  1014.       ENDIF
  1015.     ENDIF
  1016.   ENDIF
  1017. RETURN
  1018. > PROCEDURE m.edit(m.namn$,exist!)
  1019.   IF exist!
  1020.     @load_menu(m.namn$,"")
  1021.   ELSE
  1022.     m%=0
  1023.   ENDIF
  1024.   DO
  1025.     clr
  1026.     send("Name: "+m.namn$+", "+STR$(m%)+" entries")
  1027.     send(cr$+cr$+"(S)imulate, (P)rompt,  (Q)uit")
  1028.     CLR ch$
  1029.     menu("SQ",ch$)
  1030.     IF ch$="S"
  1031.       simulate_menu(255)
  1032.       send(cr$+cr$+"Simulation done, Press RETURN..."+CHR$(1))
  1033.     ELSE IF ch$="P"
  1034.     ENDIF
  1035.   LOOP UNTIL ch$="Q"
  1036.   CLR ch$
  1037. RETURN
  1038. > PROCEDURE simulate_menu(sec|)
  1039.   IF NOT hangup!
  1040.     CLR ch$
  1041.     clr
  1042.     FOR i%=0 TO m%
  1043.       IF sec|=>m.level|(i%)
  1044.         IF i%>0
  1045.           IF UPPER$(LEFT$(m.text$(i%-1),2))<>"-N"
  1046.             send(SPACE$(2-LEN(STR$(i%)))+STR$(i%)+":")
  1047.           ENDIF
  1048.         ELSE
  1049.           send(" 0:")
  1050.         ENDIF
  1051.         IF UPPER$(LEFT$(m.text$(i%),2))="-N"
  1052.           send(MID$(m.text$(i%),3))
  1053.         ELSE
  1054.           send(m.text$(i%)+cr$)
  1055.         ENDIF
  1056.       ENDIF
  1057.       '
  1058.       EXIT IF hangup!
  1059.     NEXT i%
  1060.     send("Pr:"+prompt$)
  1061.   ENDIF
  1062. RETURN
  1063. '
  1064. ' -------------------------------------------
  1065. '
  1066. > PROCEDURE login(login|)
  1067.   LOCAL l.date$
  1068.   send(cr$+"SCS BBS "+version$+" beta, (C) 1991 Jan Leveren"+cr$+cr$)
  1069.   cat("LOGO.ASC","","")
  1070.   clear_rs
  1071.   DO WHILE login|=0
  1072.     REPEAT
  1073.       username("Username:",user$)
  1074.       user$=TRIM$(user$)
  1075.     UNTIL hangup! OR LEN(user$)
  1076.     EXIT IF hangup!
  1077.     log(user$+" online in "+baud$+" baud")
  1078.     rec%=FN newuser(user$)
  1079.     EXIT IF rec%>0
  1080.     CLOSE #99
  1081.     send(cr$+"You entered "+user$+", Correct (Y/n) ?")
  1082.     CLR ch$
  1083.     menu("YN"+CHR$(13),ch$)
  1084.   LOOP UNTIL hangup! OR ch$<>"N"
  1085.   '
  1086.   IF NOT hangup!
  1087.     IF rec%>0
  1088.       get_user(99,rec%)
  1089.       INC calls&
  1090.       last_time$=LEFT$(TIME$,2)+MID$(TIME$,4,2)
  1091.       l.date$=RIGHT$(DATE$,2)+MID$(DATE$,4,2)+LEFT$(DATE$,2)
  1092.       IF l.date$<>last_date$
  1093.         last_date$=l.date$
  1094.         LET down_today&=0
  1095.         LET minutes_today&=0
  1096.       ENDIF
  1097.       put_user(99,rec%)
  1098.       CLOSE #99
  1099.       IF login|=0
  1100.         password("Password:",FALSE)
  1101.       ELSE
  1102.         hangup!=FALSE
  1103.         IF LEN(alias$)
  1104.           send("Hi "+alias$+"!")
  1105.         ELSE
  1106.           send("Hi "+user$+"!")
  1107.         ENDIF
  1108.       ENDIF
  1109.       log(user$+" ("+alias$+") online")
  1110.     ELSE
  1111.       questions
  1112.     ENDIF
  1113.     '
  1114.     IF NOT hangup!
  1115.       cat("WELCOME.ASC","P","S")
  1116.       cat("NEWS.ASC","P","S")
  1117.       clr
  1118.       checkmsgs
  1119.     ENDIF
  1120.   ENDIF
  1121. RETURN
  1122. > PROCEDURE logoff                          !Last
  1123.   IF NOT hangup!
  1124.     cat("GOODBYE.ASC","P","S")
  1125.     hangup!=TRUE
  1126.   ENDIF
  1127. RETURN
  1128. > PROCEDURE after_bbs                       !Logging, Listmaking etc
  1129.   PRINT
  1130.   @modem_stat
  1131.   IF (NOT dcd!) AND (NOT local!)
  1132.     log("Dropped Carrier"+cr$)
  1133.     IF rec%>0
  1134.       last_err$=user$+" dropped carrier"
  1135.     ELSE
  1136.       last_err$="Unknown dropped carrier"
  1137.     ENDIF
  1138.     s.dc!=TRUE
  1139.   ELSE
  1140.     log("Legal Log out"+cr$)
  1141.   ENDIF
  1142.   PRINT " o Hanging up..."
  1143.   modem(m.hangup$)
  1144.   '
  1145.   IF rec%>0
  1146.     ~@init_userfile(99)
  1147.     put_user(99,rec%)
  1148.     CLOSE #99
  1149.     IF rec%>1
  1150.       statusline
  1151.     ENDIF
  1152.   ENDIF
  1153. RETURN
  1154. '
  1155. ' -----------------------------------------< Menus
  1156. > PROCEDURE mainmenu(m.menu$,m.param$)
  1157.   WHILE NOT hangup!
  1158.     @load_menu(m.menu$,m.param$)
  1159.     show_menu
  1160.     m.tolk
  1161.   WEND
  1162. RETURN
  1163. > PROCEDURE load_menu(m.menu$,m.param$)         !Under Construction
  1164.   ERASE m.text$(),m.param$(),m.type|(),m.cost&(),m.level|(),m.flags%(),m.fc|(),m.bc|()
  1165.   DIM m.text$(50),m.param$(50),m.type|(50),m.cost&(50),m.level|(50),m.flags%(50),m.fc|(50),m.bc|(50)
  1166.   CLOSE #32
  1167.   IF NOT hangup!
  1168.     IF EXIST(menu_path$+m.menu$)
  1169.       OPEN "I",#32,menu_path$+m.menu$
  1170.     ELSE IF EXIST(menu_path$+m.menu$+".MNU")
  1171.       OPEN "I",#32,menu_path$+m.menu$+".MNU"
  1172.     ELSE
  1173.       send(cr$+UPPER$(m.menu$)+" Menu not found.")
  1174.       send(cr$+"Sysop Error, Returning to TOP menu.")
  1175.       last_err$="Menu "+m.menu$+" not found"
  1176.       mainmenu("TOP","")
  1177.     ENDIF
  1178.     LINE INPUT #32,prompt$
  1179.     m%=0
  1180.     m.key$=""
  1181.     key$=""
  1182.     DO WHILE NOT EOF(#32)
  1183.       LINE INPUT #32,m.text$(m%)
  1184.       LINE INPUT #32,m.param$(m%)
  1185.       LINE INPUT #32,m.data$
  1186.       IF LEN(m.data$) AND ((VAL(m.data$)=>0 AND LEFT$(m.data$)<>","))
  1187.         key$=LEFT$(m.data$)
  1188.       ELSE
  1189.         key$=CHR$(0)
  1190.       ENDIF
  1191.       m.data$=@komma$(m.data$)
  1192.       m.type|(m%)=VAL(m.data$)
  1193.       m.data$=@komma$(m.data$)
  1194.       m.cost&(m%)=VAL(m.data$)
  1195.       m.data$=@komma$(m.data$)
  1196.       m.level|(m%)=VAL(m.data$)
  1197.       m.data$=@komma$(m.data$)
  1198.       m.flags%(m%)=VAL(m.data$)
  1199.       m.data$=@komma$(m.data$)
  1200.       m.fc|(m%)=VAL(m.data$)
  1201.       m.data$=@komma$(m.data$)
  1202.       m.bc|(m%)=VAL(m.data$)
  1203.       IF level|=>m.level|(m%)
  1204.         m.key$=m.key$+key$
  1205.       ELSE
  1206.         m.key$=m.key$+CHR$(0)
  1207.       ENDIF
  1208.       INC m%
  1209.       EXIT IF LOF(#32)-LOC(#32)<3
  1210.     LOOP UNTIL EOF(#32)
  1211.     CLOSE #32
  1212.   ENDIF
  1213. RETURN
  1214. > PROCEDURE show_menu
  1215.   IF NOT hangup!
  1216.     reverse!=TRUE
  1217.     reverse
  1218.     CLR ch$
  1219.     clr
  1220.     FOR menu%=0 TO m%
  1221.       IF level|=>m.level|(menu%)
  1222.         IF INSTR(m.text$(menu%),"~")
  1223.           tls%=INSTR(m.text$(menu%),"~")
  1224.           IF LEN(m.text$(menu%))>1
  1225.             m.text$(menu%)=LEFT$(m.text$(menu%),tls%-1)+STR$(@timeleft)+MID$(m.text$(menu%),tls%+1)
  1226.           ELSE
  1227.             m.text$(menu%)=STR$(@timeleft)
  1228.           ENDIF
  1229.         ENDIF
  1230.         IF UPPER$(LEFT$(m.text$(menu%),2))="-N"
  1231.           send(MID$(m.text$(menu%),3))
  1232.         ELSE
  1233.           send(m.text$(menu%)+cr$)
  1234.         ENDIF
  1235.       ENDIF
  1236.       '
  1237.       IF INP?(1) OR INP?(2)
  1238.         getchr(ch$)
  1239.       ENDIF
  1240.       EXIT IF INSTR(m.key$,ch$) OR hangup!
  1241.     NEXT menu%
  1242.     IF INSTR(prompt$,"~")
  1243.       tls%=INSTR(prompt$,"~")
  1244.       IF LEN(prompt$)>1
  1245.         prompt$=LEFT$(prompt$,tls%-1)+STR$(@timeleft)+MID$(prompt$,tls%+1)
  1246.       ELSE
  1247.         prompt$=STR$(@timeleft)
  1248.       ENDIF
  1249.     ENDIF
  1250.     send(prompt$)
  1251.   ENDIF
  1252. RETURN
  1253. > PROCEDURE m.tolk
  1254.   menu(m.key$,ch$)
  1255.   send(ch$)
  1256.   m.val|=INSTR(m.key$,ch$)-1
  1257.   SELECT m.type|(m.val|)
  1258.   CASE 0
  1259.     ' TEXT LINE
  1260.   CASE 1
  1261.     split(m.param$(m.val|))
  1262.     mainmenu(part1$,part2$)
  1263.   CASE 2
  1264.     ' gosub menu
  1265.   CASE 3
  1266.     ' return from gosub
  1267.   CASE 4
  1268.     ' clear stack and goto new menu
  1269.   CASE 5
  1270.     clr
  1271.     cat(m.param$(m.val|)," P","S"+CHR$(3))
  1272.   CASE 7
  1273.     execute(m.param$(m.val|))
  1274.   CASE 8
  1275.     version
  1276.   CASE 9
  1277.     logoff
  1278.   CASE 10
  1279.     ' display graph
  1280.   CASE 11
  1281.     ' play("",m.param$(m.val|))
  1282.     yell(m.param$(m.val|))
  1283.   CASE 13
  1284.     ' list users
  1285.   CASE 14
  1286.     ' display stats
  1287.   CASE 15
  1288.     ' exit with error level
  1289.   CASE 16
  1290.     setupmenu
  1291.   CASE 22
  1292.     ' check for mail
  1293.     checkmsgs
  1294.   CASE 23
  1295.     ' read mail
  1296.     @readmsg(VAL(m.param$(m.val|)))
  1297.   CASE 25
  1298.     ' quickscan
  1299.     quickscan(VAL(m.param$(m.val|)))
  1300.   CASE 27
  1301.     ' write mail
  1302.     @writemsg(VAL(m.param$(m.val|)),"","")
  1303.   CASE 30
  1304.     ' raw dir
  1305.     rawdir(m.param$(m.val|))
  1306.   CASE 31
  1307.     ' Display file-list
  1308.     @files.bbs(m.param$(m.val|))
  1309.   CASE 32
  1310.     ' download
  1311.     @download(m.param$(m.val|),"","")
  1312.   CASE 33
  1313.     ' upload
  1314.     @upload(m.param$(m.val|))
  1315.   CASE 34
  1316.     ' list arcive
  1317.   CASE 35
  1318.     ' search
  1319.   CASE 36
  1320.     ' Long List
  1321.     '      long_list
  1322.   CASE 37
  1323.     ' new files
  1324.   CASE 38
  1325.     ' read text-file
  1326.   CASE 39
  1327.     ' display file (full path)
  1328.   CASE 40
  1329.     ' replace menutext
  1330.   CASE 41
  1331.     ' Toggle FSE
  1332.   CASE 45
  1333.     ' display text + press return
  1334.     clr
  1335.     cat(m.param$(m.val|)," P","S"+CHR$(3))
  1336.     send(cr$+"Press <RETURN>..."+CHR$(1))
  1337.   CASE 80
  1338.     ' Online Arciver
  1339.   CASE 81
  1340.     ' pump file
  1341.   CASE 83
  1342.     ' file browser
  1343.   DEFAULT
  1344.     PRINT "Unknown option...."
  1345.     PRINT
  1346.     PRINT "Keys    '";m.key$;"'";LEN(m.key$)
  1347.     PRINT "Key    '";ch$;"'"
  1348.     PRINT "Type   ";m.type|(m.val|)
  1349.     PRINT "Cost   ";m.cost&(m.val|)
  1350.     PRINT "Level  ";m.level|(m.val|)
  1351.     PRINT "Flags  ";m.flags%(m.val|)
  1352.     PRINT "FCol   ";m.fc|(m.val|);""
  1353.     PRINT "BCol   ";m.bc|(m.val|)
  1354.     PRINT "M Data '";m.param$(m.val|);"'"
  1355.     PRINT "M Text '";m.text$(m.val|);"'"
  1356.     REPEAT
  1357.     UNTIL INP?(1) OR INP?(2)
  1358.   ENDSELECT
  1359. RETURN
  1360. '
  1361. ' ------------------------------------------
  1362. '
  1363. > PROCEDURE yell(a$)
  1364.   s.yell!=TRUE
  1365.   send(cr$+""+a$)
  1366.   FOR i%=1 TO 4
  1367.     SETCOLOR 0,c&
  1368.     c&=ABS(NOT c&)
  1369.     PAUSE 20
  1370.   NEXT i%
  1371.   send(cr$+"I've send signal to SysOp, maybe he will break in if he can chat...")
  1372.   getchr(ch$)
  1373. RETURN
  1374. '
  1375. '
  1376. > PROCEDURE version                         !Menu 8
  1377.   clr
  1378.   send("SCS BBS "+version$)
  1379.   send(cr$+cr$+"Based on DemoBBS, written by Jens Bauer, 1989.")
  1380.   send(cr$+"Modified and extended by Jan Leveren, 1991.")
  1381.   send(cr$+"Programmed in GFA 3.5.")
  1382.   send(cr$+cr$+"Press <RETURN>"+CHR$(1))
  1383. RETURN
  1384. '
  1385. ' ----
  1386. ' Users Setup, first and following
  1387. '
  1388. > PROCEDURE questions                       !New User Questions
  1389.   attribut|=BSET(attribut|,0)
  1390.   clr
  1391.   '
  1392.   clear_rs
  1393.   DO
  1394.     send(cr$+"Do you wish to register as a user in Suffer City (y/n) ?")
  1395.     CLR ch$
  1396.     menu("YN",ch$)
  1397.   LOOP UNTIL hangup! OR (ch$="Y" OR ch$="N")
  1398.   IF ch$="N"
  1399.     send("Ok, Bye...")
  1400.     rec%=0
  1401.     hangup!=TRUE
  1402.   ENDIF
  1403.   '
  1404.   IF NOT hangup!
  1405.     DO                                                    ! stop=  ESC or ctrl-C
  1406.       REPEAT
  1407.         clr
  1408.         send("You may enter an alias later, now i want your real name.")
  1409.         send(cr$+cr$+"Is "+user$+" your full and real name (y/N) ?")
  1410.         CLR ch$
  1411.         menu("YN"+CHR$(13),ch$)
  1412.         IF ch$<>"Y"
  1413.           name
  1414.         ENDIF
  1415.       UNTIL LEN(user$) AND ch$="Y"
  1416.       IF @newuser(user$)>0
  1417.         send(cr$+"You are allready registred as a user here!")
  1418.         send(cr$+"Please call again and login as "+user$+".")
  1419.         send(cr$+cr$+"Bye!")
  1420.         hangup!=TRUE
  1421.         PAUSE 50
  1422.         EXIT IF TRUE
  1423.       ENDIF
  1424.       CLOSE #99
  1425.     LOOP UNTIL hangup! OR ch$<>"N"
  1426.   ENDIF
  1427.   '
  1428.   IF NOT hangup!
  1429.     calls&=1
  1430.     last_time$=LEFT$(TIME$,2)+MID$(TIME$,4,2)
  1431.     last_date$=RIGHT$(DATE$,2)+MID$(DATE$,4,2)+LEFT$(DATE$,2)
  1432.     lastmsg&=1
  1433.     lastfile&=1
  1434.     posted_msgs&=0
  1435.     uploads&=0
  1436.     LET downloads&=0
  1437.     upl_kb&=0
  1438.     LET down_kb&=0
  1439.     LET down_today&=0
  1440.     CLR city$
  1441.     CLR phone$
  1442.     '
  1443.     credits&=newusercredits&
  1444.     flags%=newuserflags%
  1445.     level|=newuserlevel|
  1446.     '
  1447.     l%=@init_userfile(99)
  1448.     '
  1449.     log("New user: "+user$)
  1450.     '
  1451.     clr
  1452.     send$="Hi, "+alias$+"! I see that you are a new user.  You must now choose a Password."
  1453.     send$=send$+"A password must be between 4 and 15 letters."
  1454.     send$=send$+"You will be asked to enter it twice, just so we can be shore."
  1455.     wrap(send$)                                         ! makes wordwrap.
  1456.     send(cr$+send$)                                         ! Send wrapped text.
  1457.     send(cr$+"Press <RETURN>..."+CHR$(1))
  1458.     CLR pass$,alias$
  1459.     pass
  1460.     IF password$=pass$
  1461.       graphics
  1462.       '
  1463.       attribut
  1464.       '
  1465.       screenl
  1466.       '
  1467.       city
  1468.       '
  1469.       phone
  1470.       '
  1471.       rec%=l%+1
  1472.       put_user(99,rec%)
  1473.       CLOSE #99
  1474.     ELSE
  1475.       send(cr$+"Sorry I have to log you off, call back sometime.")
  1476.       rec%=0
  1477.       hangup!=TRUE
  1478.     ENDIF
  1479.   ENDIF
  1480. RETURN
  1481. > PROCEDURE username(prompt$,VAR user$)     !Ask Username
  1482.   send(cr$+prompt$)
  1483.   cursor(TRUE)
  1484.   CLR user$
  1485.   input(2,35,32,user$)
  1486.   user$=TRIM$(user$)
  1487.   IF NOT hangup!
  1488.     IF INSTR(user$," ")
  1489.       alias$=LEFT$(user$,INSTR(user$," ")-1)
  1490.       lastname$=MID$(user$,INSTR(user$," ")+1)
  1491.       get_name!=FALSE
  1492.     ELSE
  1493.       alias$=name$
  1494.       CLR lastname$
  1495.       get_name!=TRUE
  1496.     ENDIF
  1497.   ENDIF
  1498. RETURN
  1499. > PROCEDURE password(prompt$,new!)          !Ask Password
  1500.   LOCAL tries|
  1501.   CLR password$
  1502.   REPEAT
  1503.     send(cr$+prompt$)
  1504.     cursor(TRUE)
  1505.     input(0,15,32,password$)
  1506.     INC tries|
  1507.     IF NOT new!
  1508.       IF password$<>pass$
  1509.         PRINT
  1510.         PRINT " o  Wrong password: ";password$;"<>";pass$
  1511.         send(cr$+"Invalid password.")
  1512.         IF tries|>3
  1513.           send(cr$+"Failed Logon. Bye "+user$+".")
  1514.           hangup!=TRUE
  1515.         ELSE
  1516.           send(" No, that's not it...")
  1517.         ENDIF
  1518.       ENDIF
  1519.     ELSE
  1520.       IF LEN(password$)<4
  1521.         IF tries#<4
  1522.           send(cr$+"A password must be MORE than 3 letters, please try again.")
  1523.         ELSE
  1524.           send(cr$+"Too many errors writing password. Bye "+user$+".")
  1525.           hangup!=TRUE
  1526.         ENDIF
  1527.       ENDIF
  1528.     ENDIF
  1529.     EXIT IF hangup!
  1530.   UNTIL (LEN(password$)>3 AND new!) OR (pass$=password$ AND NOT new!)
  1531. RETURN
  1532. '
  1533. > PROCEDURE setupmenu                       !Menu 16
  1534.   LET quit!=FALSE
  1535.   l%=@init_userfile(99)
  1536.   put_user(99,rec%)
  1537.   DO
  1538.     clr
  1539.     send("Setup for "+user$+cr$)
  1540.     send(cr$+"A) Alias           : "+alias$)
  1541.     send(cr$+"C) City            : "+city$)
  1542.     send(cr$+"P) Password        : "+"<Hidden>")       !pass$
  1543.     send(cr$+"T) Phone           : "+phone$)
  1544.     send(cr$+"G) Graphics        : ")
  1545.     SELECT graphics|
  1546.     CASE 0
  1547.       send("Ascii")
  1548.     CASE 1
  1549.       send("VT52 Mono")
  1550.     CASE 2
  1551.       send("VT52 Colour")
  1552.     CASE 3
  1553.       send("VT52 Standard")
  1554.     CASE 4
  1555.       send("Ansi")
  1556.     ENDSELECT
  1557.     send(cr$+"B) Attribut        : ")
  1558.     IF BTST(attribut|,0)
  1559.       send("CLS ")
  1560.     ENDIF
  1561.     IF BTST(attribut|,1)
  1562.       send("More ")
  1563.     ENDIF
  1564.     IF BTST(attribut|,7)
  1565.       send("Deleted")
  1566.     ENDIF
  1567.     send(cr$+"L) Lenght of Screen: "+STR$(screenlenght|))
  1568.     send(cr$+"H) Charset         : ")
  1569.     SELECT charset|
  1570.     CASE 0
  1571.       send("7 Bit Ascii")
  1572.     CASE 1
  1573.       send("PC8")
  1574.     CASE 2
  1575.       send("Iso 151")
  1576.     DEFAULT
  1577.       send("Unknown")
  1578.     ENDSELECT
  1579.     send(cr$+cr$+"S) Save and Quit")
  1580.     send(cr$+"Q) Quit")
  1581.     send(cr$+">")
  1582.     CLR ch$
  1583.     menu("ACPTGBLHSQ"+CHR$(13),ch$)
  1584.     ON INSTR("ACPTGBLHSQ",ch$) GOSUB alias,city,pass,phone,graphics,attribut,screenl,charset,save,quit
  1585.     EXIT IF quit! OR hangup!
  1586.   LOOP
  1587.   CLOSE #99
  1588. RETURN
  1589. > PROCEDURE name
  1590.   clr
  1591.   send(cr$+"Please enter your full name: ")
  1592.   input(2,35,32,user$)
  1593. RETURN
  1594. > PROCEDURE alias
  1595.   clr
  1596.   send(cr$+"Please enter your alias: ")
  1597.   input(2,15,32,alias$)
  1598.   IF LEN(alias$)
  1599.     IF @newuser(alias$)>0
  1600.       send(cr$+"Sorry but "+alias$+" is allready taken")
  1601.       send(cr$+"You have to choose again...")
  1602.       send(cr$+cr$+"Press ANY key")
  1603.       getchr(ch$)
  1604.       CLR alias$
  1605.     ENDIF
  1606.   ENDIF
  1607. RETURN
  1608. > PROCEDURE pass
  1609.   LOCAL oldpass$
  1610.   clr
  1611.   oldpass$=pass$
  1612.   CLR tries|
  1613.   REPEAT
  1614.     password(cr$+cr$+"Choose your password:",TRUE)
  1615.     pass$=password$
  1616.     password$=""
  1617.     password("           And again:",TRUE)
  1618.     IF pass$<>password$
  1619.       PRINT pass$;"<>";password$
  1620.       send(cr$+"The passwords didn't match.")
  1621.       IF tries|<4
  1622.         INC tries#
  1623.         send(" Please try again")
  1624.       ENDIF
  1625.     ENDIF
  1626.   UNTIL password$=pass$ OR tries|>3
  1627.   IF tries|>3
  1628.     pass$=oldpass$
  1629.   ENDIF
  1630. RETURN
  1631. > PROCEDURE graphics
  1632.   clr
  1633.   send("Choose some graphics:"+cr$)
  1634.   send(cr$+" 1) Ascii      (Works for everyone)")  ! Tab runs faster
  1635.   send(cr$+" 2) VT52 mono  (Atari ST Only)")
  1636.   send(cr$+" 3) VT52 color (Atari ST Only")
  1637.   send(cr$+" 4) VT52       (Standard, None Atari's VT52)")
  1638.   send(cr$+" 5) Ansi       (PC Compatible graphics)")
  1639.   send(cr$+"Your choice:")
  1640.   CLR ch$
  1641.   menu("12345"+CHR$(13),ch$)
  1642.   IF VAL(ch$)>0
  1643.     graphics|=VAL(ch$)-1
  1644.   ELSE
  1645.     graphics|=0
  1646.   ENDIF
  1647.   send(ch$)
  1648. RETURN
  1649. > PROCEDURE attribut
  1650.   clr
  1651.   attribut|=0
  1652.   ' Bit 0 = CLS
  1653.   ' Bit 1 = More
  1654.   ' Bit 7 = Deleted
  1655.   clr
  1656.   CLR ch$
  1657.   send(cr$+cr$+"Do you want Clear-Screen codes to be sent (Y/n) ?")
  1658.   menu("YN"+CHR$(13),ch$)
  1659.   attribut|=BCLR(attribut|,0)
  1660.   IF ch$<>"N"
  1661.     ch$="Y"
  1662.     attribut|=BSET(attribut|,0)
  1663.   ENDIF
  1664.   send(ch$)
  1665.   CLR ch$
  1666.   send(cr$+cr$+"Do you want Pause if text is longer then screen (Y/n) ?")
  1667.   menu("YN"+CHR$(13),ch$)
  1668.   IF ch$<>"N"
  1669.     ch$="Y"
  1670.     attribut|=BSET(attribut|,1)
  1671.   ELSE
  1672.     attribut|=BCLR(attribut|,1)
  1673.   ENDIF
  1674.   send(ch$)
  1675. RETURN
  1676. > PROCEDURE city
  1677.   clr
  1678.   send(cr$+"Where do you live? (City):")
  1679.   input(2,15,32,city$)
  1680. RETURN
  1681. > PROCEDURE phone
  1682.   clr
  1683.   send(cr$+"And your phonenumber:")
  1684.   input(1,15,32,phone$)
  1685. RETURN
  1686. > PROCEDURE screenl
  1687.   clr
  1688.   IF screenlenght|
  1689.     screenlenght$=STR$(screenlenght|)
  1690.   ELSE
  1691.     screenlenght$="24"
  1692.   ENDIF
  1693.   send(cr$+"Enter lenght of your screen (5-255):")
  1694.   input(4,3,32,screenlenght$)
  1695.   IF VAL(screenlenght$)>255
  1696.     screenlenght|=255
  1697.   ELSE IF VAL(screenlenght$)<=5
  1698.     screenlenght|=5
  1699.   ELSE
  1700.     screenlenght|=VAL(screenlenght$)
  1701.   ENDIF
  1702. RETURN
  1703. > PROCEDURE charset
  1704.   clr
  1705.   send("Choose a Charset:"+cr$)
  1706.   send(cr$+" 1) 7 bit Ascii      (Standard, Doesn't use ASCII above 127)")
  1707.   send(cr$+" 2) PC8              (Standard on ST without Keyboard-Programs)")
  1708.   send(cr$+" 3) ISO 151          (Amiga uses this)")
  1709.   send(cr$+cr$+"Your choice:")
  1710.   CLR ch$
  1711.   menu("12345"+CHR$(13),ch$)
  1712.   IF VAL(ch$)>0
  1713.     charset|=VAL(ch$)-1
  1714.   ELSE
  1715.     charset|=0
  1716.   ENDIF
  1717.   send(ch$)
  1718. RETURN
  1719. '
  1720. > PROCEDURE save
  1721.   LET quit!=TRUE
  1722.   put_user(99,rec%)
  1723.   CLOSE #99
  1724. RETURN
  1725. > PROCEDURE quit
  1726.   LET quit!=TRUE
  1727.   get_user(99,rec%)
  1728.   CLOSE #99
  1729. RETURN
  1730. ' ----
  1731. '
  1732. ' Read and write users in userfile
  1733. '
  1734. > PROCEDURE get_user(channel%,rec%)        !Read 1 user
  1735.   GET #channel%,rec%
  1736.   user$=CHAR{V:u.user$}
  1737.   city$=CHAR{V:u.city$}
  1738.   alias$=CHAR{V:u.alias$}
  1739.   pass$=CHAR{V:u.pass$}
  1740.   phone$=CHAR{V:u.phone$}
  1741.   last_time$=u.last_time$
  1742.   last_date$=u.last_date$
  1743.   attribut|=u.attribut|
  1744.   screenlenght|=u.screenlenght|
  1745.   flags%=u.flags%
  1746.   credits&=u.credits&
  1747.   posted_msgs&=u.posted_msgs&
  1748.   graphics|=u.graphics|
  1749.   level|=u.level|
  1750.   calls&=u.calls&
  1751.   uploads&=u.uploads&
  1752.   LET downloads&=u.downloads&
  1753.   upl_kb&=u.upl_kb&
  1754.   LET down_kb&=u.down_kb&
  1755.   LET down_today&=u.down_today&
  1756.   minutes_today&=u.minutes_today&
  1757.   lastfile&=u.lastfile&
  1758.   lastmsg&=u.lastmsg&
  1759.   charset|=u.charset|
  1760. RETURN
  1761. > PROCEDURE put_user(channel%,rec%)        !Write 1 user
  1762.   LSET u.user$=user$+CHR$(0)
  1763.   LSET u.city$=city$+CHR$(0)
  1764.   LSET u.alias$=alias$+CHR$(0)
  1765.   LSET u.pass$=pass$+CHR$(0)
  1766.   LSET u.phone$=phone$+CHR$(0)
  1767.   LSET u.last_time$=last_time$+CHR$(0)
  1768.   LSET u.last_date$=last_date$+CHR$(0)
  1769.   u.attribut|=attribut|
  1770.   u.screenlenght|=screenlenght|
  1771.   u.flags%=flags%
  1772.   u.credits&=credits&
  1773.   u.posted_msgs&=posted_msgs&
  1774.   u.graphics|=graphics|
  1775.   u.level|=level|
  1776.   u.calls&=calls&
  1777.   u.uploads&=uploads&
  1778.   u.downloads&=downloads&
  1779.   u.upl_kb&=upl_kb&
  1780.   u.down_kb&=down_kb&
  1781.   u.down_today&=down_today&
  1782.   u.minutes_today&=minutes_today&
  1783.   u.lastfile&=lastfile&
  1784.   u.lastmsg&=lastmsg&
  1785.   u.charset|=charset|
  1786.   PUT #channel%,rec%
  1787. RETURN
  1788. '
  1789. ' -----------------------------------------< File Functions
  1790. '
  1791. > PROCEDURE files.bbs(file_path$)          !Menu 37
  1792.   clr
  1793.   IF EXIST(file_path$+"FILES.BBS")
  1794.     OPEN "I",#1,file_path$+"FILES.BBS"
  1795.     lfd%=@init_files.dat(file_path$)
  1796.     REPEAT
  1797.       LINE INPUT #1,a$
  1798.       IF INSTR(" -/+=",LEFT$(a$))
  1799.       ELSE
  1800.         IF LEN(a$)=0
  1801.           '
  1802.         ELSE IF INSTR(a$," ")
  1803.           file$=UPPER$(LEFT$(a$,INSTR(a$," ")-1))
  1804.           desc$=MID$(a$,INSTR(a$," ")+1)
  1805.           a$=file$+SPACE$(13-LEN(file$))
  1806.           a$=a$+" "+@files$(file_path$+file$)+desc$
  1807.           a$=@file_wrap$(a$)
  1808.         ENDIF
  1809.       ENDIF
  1810.       send(a$+cr$)
  1811.     UNTIL EOF(#1)
  1812.     CLOSE #1
  1813.     CLOSE #16
  1814.   ENDIF
  1815.   '
  1816.   send(cr$+cr$+"Press <RETURN>..."+CHR$(1))
  1817. RETURN
  1818. > PROCEDURE long_list                      !Menu 36
  1819.   clr
  1820.   OPEN "I",#1,file_path$+"FILES.BBS"
  1821.   lfd%=@init_files.dat(file_path$)
  1822.   IF lfd%=1
  1823.     send(cr$+"1 file, <Return>=lastfile, start with:")
  1824.   ELSE
  1825.     send(cr$+STR$(lfd%)+" files, <Return>=lastfile, start with:")
  1826.   ENDIF
  1827.   CLR inp$
  1828.   input(1,5,32,inp$)
  1829.   IF inp$=""
  1830.     f%=lastfile&
  1831.   ELSE
  1832.     f%=VAL(inp$)
  1833.   ENDIF
  1834.   IF f%<1
  1835.     f%=1
  1836.   ELSE IF f%>lfd%
  1837.     f%=lfd%
  1838.   ENDIF
  1839.   clr
  1840.   FOR file%=f% TO lfd%
  1841.     get_files.dat(file%)
  1842.     IF BTST(fdelete|,0)=FALSE
  1843.       SEEK #1,1
  1844.       REPEAT
  1845.         a$=""
  1846.         file$=""
  1847.         desc$=""
  1848.         found!=FALSE
  1849.         LINE INPUT #1,a$
  1850.         IF INSTR(a$," ")
  1851.           file$=UPPER$(LEFT$(a$,INSTR(a$," ")-1))
  1852.           IF file$=ffilename$
  1853.             desc$=MID$(a$,INSTR(a$," ")+1)
  1854.             a$=file$+SPACE$(13-LEN(file$))
  1855.             a$=a$+" "+@files$(file_path$+file$)
  1856.             send(cr$+STR$(file%)+". "+a$+cr$)
  1857.             send("Uploader: "+fuploader$+cr$)
  1858.             wrap(desc$)
  1859.             send(desc$+cr$)
  1860.             found!=TRUE
  1861.             EXIT IF TRUE
  1862.           ENDIF
  1863.         ENDIF
  1864.       UNTIL EOF(#1)
  1865.       IF found!=TRUE
  1866.         send("(N)ext, (D)ownload, (Q)uit")
  1867.         CLR ch$
  1868.         menu("NDQ"+CHR$(13),ch$)
  1869.         IF ch$="N" OR ch$=CHR$(13)
  1870.           send(cr$)
  1871.         ELSE IF ch$="D"
  1872.           download(file_path$,ffilename$,"")
  1873.         ELSE IF ch$="Q"
  1874.           EXIT IF TRUE
  1875.         ENDIF
  1876.       ENDIF
  1877.     ENDIF
  1878.   NEXT file%
  1879.   DEC file%
  1880.   CLOSE #1
  1881.   CLOSE #16
  1882.   IF file%>lastfile&
  1883.     lastfile&=file%
  1884.   ENDIF
  1885.   '
  1886. RETURN
  1887. > PROCEDURE rawdir(file_path$)             !Menu 30
  1888.   clr
  1889.   send("Please enter filespec's: ")
  1890.   file$="*.*"
  1891.   input(3,12,32,file$)
  1892.   @dir(file_path$+file$)
  1893.   send(cr$+cr$+"Press <RETURN>"+CHR$(1))
  1894. RETURN
  1895. > PROCEDURE download(file_path$,file$,pro$)!Menu 32
  1896.   LOCAL oldbaud%
  1897.   proto!=TRUE
  1898.   IF LEN(pro$)=0
  1899.     clr
  1900.     send("Please choose protokoll:"+cr$)
  1901.     send(cr$+" X) Xmodem")
  1902.     send(cr$+" K) Xmodem 1K")
  1903.     send(cr$+" Y) Ymodem")
  1904.     send(cr$+" Z) Zmodem")
  1905.     send(cr$+" Q) Quit")
  1906.     send(cr$+cr$+"Your choice:")
  1907.     CLR ch$
  1908.     menu("XKYZQ"+CHR$(13),ch$)
  1909.   ELSE
  1910.     ch$=pro$
  1911.   ENDIF
  1912.   SELECT ch$
  1913.   CASE "X"
  1914.     send("Xmodem")
  1915.     batch!=FALSE
  1916.   CASE "K"
  1917.     send("Xmodem 1K")
  1918.     batch!=FALSE
  1919.   CASE "Y"
  1920.     send("Ymodem")
  1921.     batch!=TRUE
  1922.   CASE "Z"
  1923.     send("Zmodem")
  1924.     batch!=TRUE
  1925.   DEFAULT
  1926.     send("Quit")
  1927.     proto!=FALSE
  1928.   ENDSELECT
  1929.   IF proto! AND NOT hangup!
  1930.     IF LEN(file$)=0
  1931.       clr
  1932.       IF batch!=TRUE
  1933.         send(cr$+"Please enter file('s) Wildcards are valid: ")
  1934.         input(3,80,32,file$)
  1935.       ELSE
  1936.         send(cr$+"Please enter file: ")
  1937.         input(3,12,32,file$)
  1938.       ENDIF
  1939.     ENDIF
  1940.     '
  1941.     fil$=""
  1942.     f$=file$
  1943.     size%=0
  1944.     DO
  1945.       IF INSTR(f$," ")
  1946.         a$=TRIM$(LEFT$(f$,INSTR(f$," ")))
  1947.         f$=TRIM$(MID$(f$,INSTR(f$," ")))
  1948.       ELSE
  1949.         a$=f$
  1950.         f$=""
  1951.       ENDIF
  1952.       a$=@find_file$(file_path$+a$,batch!)
  1953.       size%=size%+VAL(a$)
  1954.       fil$=fil$+MID$(a$,VAL?(a$)+1)
  1955.     LOOP WHILE LEN(f$)>0
  1956.     oldbaud%=VAL(baud$)
  1957.     SELECT oldbaud%
  1958.     CASE 300
  1959.       bpm%=37.5
  1960.     CASE 1200
  1961.       bpm%=150
  1962.     CASE 2400
  1963.       bpm%=300
  1964.     CASE 9600
  1965.       bpm%=1400
  1966.     CASE 19200
  1967.       bpm%=1750
  1968.     DEFAULT
  1969.       bpm%=1400
  1970.     ENDSELECT
  1971.     need%=INT(((size%/bpm%)/60)+0.5)
  1972.     '
  1973.     IF ch$="X"
  1974.       split(x_down$)
  1975.     ELSE IF ch$="K"
  1976.       split(k_down$)
  1977.     ELSE IF ch$="Y"
  1978.       split(y_down$)
  1979.     ELSE IF ch$="Z"
  1980.       split(z_down$)
  1981.     ENDIF
  1982.     IF LEN(TRIM$(fil$))
  1983.       clr
  1984.       t.fil$="Ready to send:"+fil$
  1985.       wrap(t.fil$)
  1986.       send(t.fil$+cr$)
  1987.       send("Size: "+STR$(size%)+" Bytes, Time Needed: "+STR$(need%)+" minutes."+cr$)
  1988.       send("Please prepare to recive file(s)"+cr$)
  1989.       part2$=part2$+" "+file$
  1990.       old_dir$=@cwd$
  1991.       ~@chd(file_path$)
  1992.       e%=@run(part1$,part2$)
  1993.       ~@chd(old_dir$)
  1994.       log("Downloaded "+file$+" using "+ch$+", Return "+STR$(e%))
  1995.       clear_rs
  1996.       IF e%=0
  1997.         send(cr$+cr$+"Transfer completed!")
  1998.         lfd%=@init_files.dat(file_path$)
  1999.         ~@update_fcount(fil$)
  2000.         CLOSE #16
  2001.         ADD down_kb&,INT(size%/1024)
  2002.         ADD down_today&,INT(size%/1024)
  2003.       ELSE IF e%=3
  2004.         send(cr$+cr$+"Transfer Aborted!")
  2005.       ELSE
  2006.         last_err$="Error "+STR$(e%)+" from Download-protokoll ("+ch$+")."
  2007.         send(cr$+cr$+"Error "+STR$(e%)+" from protokoll.")
  2008.       ENDIF
  2009.       send(cr$+cr$+"Press <RETURN>..."+CHR$(1))
  2010.     ELSE
  2011.       send(cr$+cr$+"File(s) not found!")
  2012.       send(cr$+cr$+"Press <RETURN>..."+CHR$(1))
  2013.     ENDIF
  2014.   ENDIF
  2015.   CLR ch$
  2016. RETURN
  2017. > PROCEDURE upload(file_path$)             !Menu 33
  2018.   LOCAL file$
  2019.   proto!=TRUE
  2020.   clr
  2021.   send("Please choose protokoll:"+cr$)
  2022.   send(cr$+" X) Xmodem")
  2023.   send(cr$+" K) Xmodem 1K")
  2024.   send(cr$+" Y) Ymodem")
  2025.   send(cr$+" Z) Zmodem")
  2026.   send(cr$+" Q) Quit")
  2027.   send(cr$+cr$+"Your choice:")
  2028.   CLR ch$
  2029.   menu("XKYZQ"+CHR$(13),ch$)
  2030.   SELECT ch$
  2031.   CASE "X"
  2032.     send("Xmodem")
  2033.     batch!=FALSE
  2034.   CASE "K"
  2035.     send("Xmodem 1K")
  2036.     batch!=FALSE
  2037.   CASE "Y"
  2038.     send("Ymodem")
  2039.     batch!=TRUE
  2040.   CASE "Z"
  2041.     send("Zmodem")
  2042.     batch!=TRUE
  2043.   DEFAULT
  2044.     send("Quit")
  2045.     proto!=FALSE
  2046.   ENDSELECT
  2047.   clr
  2048.   IF proto! AND NOT batch!
  2049.     send("Please enter filename: ")
  2050.     input(3,12,32,file$)
  2051.     IF EXIST(file_path$+file$)
  2052.       send(cr$+"We allready got "+file$)
  2053.       send(cr$+cr$+"Press ANY key")
  2054.       getchr(ch$)
  2055.       proto!=FALSE
  2056.     ENDIF
  2057.   ENDIF
  2058.   IF proto! AND NOT hangup!
  2059.     old_dir$=@cwd$
  2060.     ~@chd(file_path$)
  2061.     IF ch$="X"
  2062.       split(x_up$)
  2063.     ELSE IF ch$="K"
  2064.       split(k_up$)
  2065.     ELSE IF ch$="Y"
  2066.       split(y_up$)
  2067.     ELSE IF ch$="Z"
  2068.       split(z_up$)
  2069.     ENDIF
  2070.     IF batch!=FALSE
  2071.       part2$=part2$+" "+file$
  2072.     ENDIF
  2073.     clr
  2074.     send("Ready to recive, please start sending file(s)"+cr$)
  2075.     e%=@run(part1$,part2$)
  2076.     ~@chd(old_dir$)
  2077.     log("Uploaded "+file$+" Using "+ch$+", Returned "+STR$(e%)+".")
  2078.     clear_rs
  2079.     IF e%
  2080.       last_err$="Error "+STR$(e%)+" from Upload-protokoll ("+ch$+")."
  2081.       send(cr$+"Error "+STR$(e%)+" from "+part1$)
  2082.       send(cr$+cr$+"Press ANY key")
  2083.       getchr(ch$)
  2084.     ENDIF
  2085.   ENDIF
  2086. RETURN
  2087. > PROCEDURE split(a$)                      !Divide line (first word - The rest)
  2088.   IF INSTR(a$," ")
  2089.     part1$=TRIM$(LEFT$(a$,INSTR(a$," ")))
  2090.     part2$=TRIM$(MID$(a$,INSTR(a$," ")))
  2091.   ELSE
  2092.     part1$=a$
  2093.     part2$=""
  2094.   ENDIF
  2095. RETURN
  2096. > PROCEDURE dir(path$)                     !Part 2 of Rawdir
  2097.   LOCAL t%,t$,d%,d$,size$,namn$
  2098.   '
  2099.   clr
  2100.   send("Name          Size    Date   Time")
  2101.   send(cr$+"----------------------------------")
  2102.   ~FSETDTA(BASEPAGE+128)
  2103.   e%=FSFIRST(path$,-1)
  2104.   DO UNTIL e%
  2105.     a|=PEEK(BASEPAGE+128+21)     !Attribut
  2106.     IF (NOT BTST(a|,1)) AND (NOT BTST(a|,2)) AND (NOT BTST(a|,3)) AND (NOT BTST(a|,4))
  2107.       t%=DPEEK(BASEPAGE+128+22)    !time
  2108.       d%=DPEEK(BASEPAGE+128+24)    !Date
  2109.       size$=STR$({BASEPAGE+128+26})!Size
  2110.       namn$=CHAR{BASEPAGE+158}
  2111.       '
  2112.       namn$=namn$+SPACE$(14-LEN(namn$))
  2113.       size$=size$+SPACE$(7-LEN(size$))
  2114.       '
  2115.       d$=" "+STR$(d% DIV 512+80)
  2116.       d$=d$+RIGHT$("0"+STR$(d%/32 AND 15),2)
  2117.       d$=d$+RIGHT$("0"+STR$(d% AND 31),2)
  2118.       '
  2119.       t$=" "+RIGHT$("0"+STR$(t% DIV 2048),2)+":"
  2120.       t$=t$+RIGHT$("0"+STR$(t% DIV 32 AND 63),2)
  2121.       ' t$=t$+RIGHT$("0"+STR$(t%+t% AND 63),2)
  2122.       send(cr$+namn$+size$+d$+t$)
  2123.     ENDIF
  2124.     e%=FSNEXT()
  2125.   LOOP
  2126. RETURN
  2127. '
  2128. ' -----------------------------------------< MSG Functions
  2129. '
  2130. > PROCEDURE writemsg(area|,usr$,subject$)  !Menu 27
  2131.   LOCAL found!,private!,nomsg!,to$,inp$,line%,line$,ch$,nomsg#
  2132.   allow_alias!=TRUE
  2133.   reply!=NOT (usr$="")
  2134.   IF NOT reply!
  2135.     open_header(area|)
  2136.   ENDIF
  2137.   clr
  2138.   IF allow_alias!
  2139.     from(from$)
  2140.   ELSE
  2141.     from$=user$
  2142.   ENDIF
  2143.   IF NOT reply!
  2144.     clr
  2145.     to(usr$)
  2146.   ENDIF
  2147.   clr
  2148.   private
  2149.   clr
  2150.   IF NOT reply!
  2151.     @subject(subject$)
  2152.     IF nomsg!
  2153.       GOTO write_out
  2154.     ENDIF
  2155.   ENDIF
  2156.   line%=1
  2157. cont:
  2158.   clr
  2159.   IF private!
  2160.     send("Private message")
  2161.   ELSE
  2162.     send("Public Message")
  2163.   ENDIF
  2164.   send(cr$+"From   : "+from$)
  2165.   send(cr$+"To     : "+usr$)
  2166.   send(cr$+"Subject: "+subject$+cr$)
  2167.   IF line%<100
  2168.     DEC line%
  2169.     REPEAT
  2170.       INC line%
  2171.       line$=RIGHT$("00"+STR$(line%)+":",4)
  2172.       send(cr$+line$)
  2173.       inp$=rest$
  2174.       CLR rest$
  2175.       input(5,75,32,inp$)
  2176.       IF wordwrap!
  2177.         rest$=inp$
  2178.         IF RINSTR(rest$," ")
  2179.           rest$=MID$(rest$,RINSTR(rest$," ")+1)
  2180.         ELSE
  2181.           rest$=MID$(inp$,76)
  2182.         ENDIF
  2183.         send(STRING$(LEN(rest$),8)+STRING$(LEN(rest$),32))
  2184.         inp$=LEFT$(inp$,MAX(0,LEN(inp$)-LEN(rest$)-1))
  2185.       ENDIF
  2186.       msg$(line%)=inp$
  2187.     UNTIL inp$="" OR line%>99
  2188.   ENDIF
  2189.   IF line%>99
  2190.     send(cr$+"Continue in another message...")
  2191.     line%=100
  2192.   ENDIF
  2193. menu:
  2194.   send(cr$+"(C)ontinue  (D)elete  (E)dit  (I)nsert  (L)ist  (P)rivate  (Q)uit")
  2195.   send(cr$+"sub(J)ect  (T)o  (S)ave")
  2196.   CLR ch$
  2197.   menu("CDEILPQJTS",ch$)
  2198.   send(ch$)
  2199.   IF ch$="C"
  2200.     GOTO cont
  2201.   ENDIF
  2202.   IF ch$="I"
  2203.     send(cr$+"Before which line ? (1-"+STR$(line%-1)+")")
  2204.     CLR inp$
  2205.     input(4,2,32,inp$)
  2206.     fra#=VAL(inp$)
  2207.     IF fra#<>0 AND fra#<line%
  2208.       send(cr$+"How many lines ?")
  2209.       CLR inp$
  2210.       input(4,2,32,inp$)
  2211.       inp#=VAL(inp$)
  2212.       IF inp#>0
  2213.         FOR f#=1 TO inp#
  2214.           FOR n#=line%+1 DOWNTO fra#
  2215.             IF n#<100
  2216.               SWAP msg$(n#+1),msg$(n#)
  2217.             ENDIF
  2218.           NEXT n#
  2219.           IF line%<100
  2220.             INC line%
  2221.           ENDIF
  2222.           msg$(100)=""
  2223.         NEXT f#
  2224.       ENDIF
  2225.     ENDIF
  2226.   ENDIF
  2227.   IF ch$="D"
  2228.     send(cr$+"What lines ? (1-"+STR$(line%-1)+")")
  2229.     CLR inp$
  2230.     input(1,75,32,inp$)
  2231.     IF INSTR(inp$,"-")
  2232.       inp#=VAL(inp$)
  2233.       IF inp#=0
  2234.         inp#=1
  2235.       ENDIF
  2236.       inp$=MID$(inp$,INSTR(inp$,"-")+1)
  2237.       inp2#=VAL(inp$)
  2238.       IF inp2#=0
  2239.         inp2#=1
  2240.       ENDIF
  2241.       IF inp#>inp2#
  2242.         SWAP inp#,inp2#
  2243.       ENDIF
  2244.       FOR n#=inp# TO inp2#
  2245.         FOR f#=inp# TO line%
  2246.           SWAP msg$(f#),msg$(f#+1)
  2247.         NEXT f#
  2248.         msg$(line%)=""
  2249.         DEC line%
  2250.       NEXT n#
  2251.     ELSE
  2252.       inp#=VAL(inp$)
  2253.       IF inp#<line% AND inp#>0
  2254.         FOR f#=inp# TO line%
  2255.           SWAP msg$(f#),msg$(f#+1)
  2256.         NEXT f#
  2257.         msg$(line%)=""
  2258.         DEC line%
  2259.       ENDIF
  2260.     ENDIF
  2261.   ENDIF
  2262.   IF ch$="E"
  2263.     send(cr$+"Which line ?")
  2264.     CLR inp$
  2265.     input(1,75,32,inp$)
  2266.     inp#=VAL(inp$)
  2267.     IF inp#=0
  2268.       inp#=1
  2269.     ENDIF
  2270.     inp$=msg$(inp#)
  2271.     line$=RIGHT$("000"+STR$(inp#)+":",4)
  2272.     send(cr$+line$)
  2273.     input(1,75,32,inp$)
  2274.     msg$(inp#)=inp$
  2275.   ENDIF
  2276.   IF ch$="L"
  2277.     send(cr$+"Which line ? (1-"+STR$(line%-1)+")")
  2278.     CLR inp$
  2279.     input(1,75,32,inp$)
  2280.     IF INSTR(inp$,"-")
  2281.       inp#=VAL(inp$)
  2282.       IF inp#=0
  2283.         inp#=1
  2284.       ENDIF
  2285.       inp$=MID$(inp$,INSTR(inp$,"-")+1)
  2286.       inp2#=VAL(inp$)
  2287.       IF inp#=0
  2288.         inp#=1
  2289.       ENDIF
  2290.       IF inp#>inp2#
  2291.         SWAP inp#,inp2#
  2292.       ENDIF
  2293.       FOR f#=inp# TO inp2#
  2294.         IF f#<line% AND f#>0
  2295.           line$=RIGHT$("000"+STR$(f#)+":",4)
  2296.           send(cr$+line$+msg$(f#))
  2297.         ENDIF
  2298.       NEXT f#
  2299.     ELSE
  2300.       inp#=VAL(inp$)
  2301.       IF inp#<line% AND inp#>0
  2302.         line$=RIGHT$("000"+STR$(inp#)+":",4)
  2303.         send(cr$+line$+msg$(inp#))
  2304.       ENDIF
  2305.     ENDIF
  2306.   ENDIF
  2307.   IF ch$="P"
  2308.     private
  2309.   ENDIF
  2310.   IF ch$="J"
  2311.     @subject(subject$)
  2312.   ENDIF
  2313.   IF ch$="T"
  2314.     to(usr$)
  2315.   ENDIF
  2316.   IF ch$="S"
  2317.     outdata$=""
  2318.     FOR f%=0 TO line%
  2319.       msg$=""
  2320.       FOR j%=1 TO LEN(msg$(f%))
  2321.         a$=MID$(msg$(f%),j%,1)
  2322.         SELECT a$
  2323.         CASE 10
  2324.         CASE 13
  2325.           msg$=msg$+CHR$(10)
  2326.         DEFAULT
  2327.           msg$=msg$+a$
  2328.         ENDSELECT
  2329.       NEXT j%
  2330.       outdata$=outdata$+msg$+CHR$(10)
  2331.     NEXT f%
  2332.     outdata$=outdata$+CHR$(10)+" -- SCS BBS "+version$+CHR$(0)
  2333.     @save_msg(my_zone&,my_net&,my_node&,my_point&,from$,usr$,subject$,outdata$)
  2334.     INC posted_msgs&
  2335.     s.msgs!=TRUE
  2336.     ~@init_userfile(99)
  2337.     put_user(99,rec%)
  2338.     CLOSE #99
  2339.   ENDIF
  2340.   IF ch$="Q"
  2341.     send(cr$+"Throw away message (y/N) ?")
  2342.     CLR ch$
  2343.     menu("YN"+CHR$(13),ch$)
  2344.     IF ch$<>"Y"
  2345.       GOTO menu
  2346.     ENDIF
  2347.   ELSE
  2348.     IF ch$<>"S" AND ch$<>"Y"
  2349.       GOTO menu
  2350.     ENDIF
  2351.   ENDIF
  2352. write_out:
  2353. RETURN
  2354. > PROCEDURE private                        !Ask Private if allowed
  2355.   IF usr$<>"All"
  2356.     send(cr$+"Private message (y/N) ?")
  2357.     CLR ch$
  2358.     menu("YN"+CHR$(13),ch$)
  2359.     send(ch$)
  2360.     CLR private!
  2361.     IF ch$="Y"
  2362.       private!=TRUE
  2363.     ENDIF
  2364.   ELSE
  2365.     private!=FALSE
  2366.   ENDIF
  2367. RETURN
  2368. > PROCEDURE searchmsg(area|)                 !Menu 23
  2369.   '  dec!=FALSE
  2370.   abort!=FALSE
  2371.   REPEAT
  2372.     hangup!=(NOT @cd IMP NOT local!)
  2373.     IF INP?(1) OR INP?(2)
  2374.       getchr(ch$)
  2375.       IF ch$="" OR ch$=CHR$(3)
  2376.         send(CHR$(13)+"-*- Aborted -*-"+cr$)
  2377.         getchr(ch$)
  2378.         abort!=TRUE
  2379.       ENDIF
  2380.     ENDIF
  2381.     EXIT IF hangup! OR abort!
  2382.     '
  2383.     IF dec!
  2384.       DEC f%
  2385.       IF f%<1
  2386.         f%=1
  2387.         send(cr$+"No more previous messages.")
  2388.         abort!=TRUE
  2389.       ENDIF
  2390.     ELSE
  2391.       INC f%
  2392.       IF f%>messages%
  2393.         f%=messages%
  2394.         abort!=TRUE
  2395.       ENDIF
  2396.     ENDIF
  2397.     '
  2398.     convert(f%)
  2399.     private!=BTST(attributes&,0)
  2400.     deleted!=BTST(attributes&,15)
  2401.     IF deleted! AND level|=>250
  2402.       deleted!=FALSE
  2403.     ENDIF
  2404.     IF private! AND level|=>250
  2405.       private!=FALSE
  2406.     ELSE IF from$=user$ OR from$=alias$
  2407.       private!=FALSE
  2408.     ELSE IF to$=user$ OR to$=alias$
  2409.       private!=FALSE
  2410.     ENDIF
  2411.     EXIT IF abort! OR hangup!
  2412.   UNTIL (NOT deleted!) AND (NOT private!)
  2413. RETURN
  2414. '
  2415. > PROCEDURE readmsg(area|)                 !Menu 23
  2416.   open_header(area|)
  2417.   IF number_msgs%>0
  2418.     messages%=number_msgs%
  2419.   ENDIF
  2420.   '
  2421.   IF messages%=1
  2422.     send(cr$+"1 message, <Return>=lastread, start with:")
  2423.   ELSE
  2424.     send(cr$+STR$(messages%)+" messages, <Return>=lastread, start with:")
  2425.   ENDIF
  2426.   CLR inp$
  2427.   input(4,5,32,inp$)
  2428.   IF inp$=""
  2429.     f%=lastmsg&
  2430.   ELSE
  2431.     f%=VAL(inp$)
  2432.   ENDIF
  2433.   IF f%<1
  2434.     f%=1
  2435.   ELSE IF f%>messages%
  2436.     f%=messages%
  2437.   ENDIF
  2438.   DEC f%
  2439.   dec!=FALSE
  2440.   '
  2441.   DO
  2442.     send(cr$+"Looking for messages... (Press S to Stop, P to pause.)")
  2443.     searchmsg(area|)
  2444.     DO WHILE NOT abort! AND NOT hangup!
  2445.       again!=FALSE
  2446.       '
  2447.       ' Header
  2448.       '
  2449.       clr
  2450.       IF BTST(attributes&,0)
  2451.         send("Private message")
  2452.       ELSE
  2453.         send("Public message")
  2454.       ENDIF
  2455.       IF BTST(attributes&,8)
  2456.         send(", Local")
  2457.       ENDIF
  2458.       IF BTST(attributes&,15)
  2459.         send(", (Deleted).")
  2460.       ELSE
  2461.         send(".")
  2462.       ENDIF
  2463.       send(cr$+"Message #"+STR$(f%)+" of #"+STR$(messages%))
  2464.       send(cr$+"Date   : "+datum$)
  2465.       send(cr$+"From   : "+from$)
  2466.       send(cr$+"To     : "+to$)
  2467.       send(cr$+"Subject: "+subj$+cr$+cr$)
  2468.       '
  2469.       ' Message
  2470.       '
  2471.       CLR ch$,col|,line&
  2472.       ud$=@read_msgs$(offset%,size&)
  2473.       FOR i%=1 TO LEN(ud$)
  2474.         a|=ASC(MID$(ud$,i%,1))
  2475.         '
  2476.         SELECT a|
  2477.         CASE 1
  2478.           ' ^A
  2479.         CASE 10
  2480.           send(cr$)
  2481.           INC line&
  2482.           col|=0
  2483.         CASE 13
  2484.           '
  2485.         DEFAULT
  2486.           OUT 2,a|
  2487.           IF NOT local!
  2488.             DO
  2489.               @modem_stat
  2490.               hangup!=(NOT dcd!) AND (NOT local!)
  2491.             LOOP UNTIL OUT?(1)
  2492.             EXIT IF hangup!
  2493.             OUT 1,a|
  2494.           ENDIF
  2495.           INC col|
  2496.           IF col|=>79
  2497.             col|=0
  2498.             send(" ")
  2499.             DO
  2500.               DEC i%
  2501.               a$=MID$(ud$,i%,1)
  2502.               IF a$=" " OR a$="." OR a$="-" OR a$="," OR a$="?" OR a$="!"
  2503.                 send(cr$)
  2504.                 INC line&
  2505.                 EXIT IF TRUE
  2506.               ELSE
  2507.                 send(" ")
  2508.               ENDIF
  2509.             LOOP
  2510.           ENDIF
  2511.         ENDSELECT
  2512.         '
  2513.         IF INP?(1) OR INP?(2)             !Hotkeys
  2514.           getchr(ch$)
  2515.           ch$=UPPER$(ch$)
  2516.           IF ch$=CHR$(32) OR ch$="P"
  2517.             send(cr$+"-*- Paused -*-")
  2518.             getchr(ch$)
  2519.             send(CHR$(13)+"              "+CHR$(13))
  2520.           ELSE IF ch$="S"
  2521.             CLR ch$
  2522.             EXIT IF TRUE
  2523.           ELSE IF ch$=CHR$(3)
  2524.             abort!=TRUE
  2525.             EXIT IF TRUE
  2526.           ELSE IF INSTR("ALNR"+CHR$(13),ch$)
  2527.             EXIT IF TRUE
  2528.           ENDIF
  2529.         ENDIF
  2530.         '
  2531.       NEXT i%
  2532.       '
  2533.       IF ch$="" OR ch$=CHR$(3)
  2534.         send(CHR$(13)+"-*- Aborted -*-"+cr$)
  2535.         abort!=TRUE
  2536.         FOR i%=1 TO 1000
  2537.           EXIT IF INP?(1) OR INP?(2)
  2538.         NEXT i%
  2539.       ENDIF
  2540.       IF f%>lastmsg&
  2541.         lastread!=TRUE
  2542.         lastmsg&=f%
  2543.       ENDIF
  2544.       IF ch$=""
  2545.         IF f%<=messages%
  2546.           send(CHR$(13)+"(A)gain (N)ext (L)ast (R)eply (Q)uit")
  2547.           IF delete$<>""
  2548.             send(" (D)elete")
  2549.           ENDIF
  2550.         ENDIF
  2551.         menu("ANLQR"+delete$+CHR$(13),ch$)
  2552.       ENDIF
  2553.       IF ch$="Q"
  2554.         send(cr$+"Quit")
  2555.         abort!=TRUE
  2556.       ELSE IF ch$="L"
  2557.         send(cr$+"Last")
  2558.         dec!=TRUE
  2559.       ELSE IF ch$="R"
  2560.         old_f%=f%
  2561.         writemsg(area|,from$,subj$)
  2562.         f%=old_f%
  2563.       ELSE IF ch$="A"
  2564.         send(cr$+"Again")
  2565.         again!=TRUE
  2566.       ELSE IF ch$="N" OR ch$=CHR$(13)
  2567.         send(cr$+"Next")
  2568.         dec!=FALSE
  2569.       ENDIF
  2570.       EXIT IF hangup!
  2571.     LOOP UNTIL NOT again! OR abort!
  2572.   LOOP UNTIL abort! OR hangup!
  2573.   IF NOT abort!
  2574.     send(cr$+"*** End of messages ***")
  2575.     FOR i%=1 TO 1000
  2576.       EXIT IF INP?(1) OR INP?(2)
  2577.     NEXT i%
  2578.   ENDIF
  2579.   IF lastread!
  2580.     ~@init_userfile(99)
  2581.     put_user(99,rec%)
  2582.     CLOSE #99
  2583.   ENDIF
  2584. RETURN
  2585. > PROCEDURE checkmsgs                      !Like Opus, Menu 22
  2586.   LOCAL messages%,mess!
  2587.   area|=1
  2588.   open_header(1)
  2589.   IF number_msgs%>0
  2590.     messages%=number_msgs%
  2591.   ELSE
  2592.     messages%=0
  2593.   ENDIF
  2594.   '
  2595.   f%=lastmsg&
  2596.   '
  2597.   send(cr$+"Looking for messages to you... (Press S to Stop)")
  2598.   FOR i%=f% TO messages%
  2599.     abort!=FALSE
  2600.     IF INP?(1) OR INP?(2)
  2601.       getchr(ch$)
  2602.       IF ch$="" OR ch$=CHR$(3)
  2603.         send(CHR$(13)+"-*- Aborted -*-"+cr$)
  2604.         getchr(ch$)
  2605.         abort!=TRUE
  2606.       ENDIF
  2607.     ENDIF
  2608.     EXIT IF hangup! OR abort!
  2609.     '
  2610.     '
  2611.     convert(i%)
  2612.     IF to$=user$ OR to$=alias$
  2613.       IF mess!
  2614.         send(STR$(i%)+" ")
  2615.       ELSE
  2616.         send(cr$+"Don't forget to read your mail: "+STR$(i%)+" ")
  2617.         mess!=TRUE
  2618.       ENDIF
  2619.     ENDIF
  2620.     EXIT IF abort! OR hangup!
  2621.   NEXT i%
  2622.   CLOSE #59
  2623.   IF mess!=TRUE
  2624.     send(cr$+cr$+"Press RETURN..."+CHR$(1))
  2625.   ENDIF
  2626. RETURN
  2627. > PROCEDURE quickscan(area|)               !Menu 25
  2628.   open_header(area|)
  2629.   IF number_msgs%>0
  2630.     messages%=number_msgs%
  2631.   ENDIF
  2632.   '
  2633.   IF messages%=1
  2634.     send(cr$+"1 message, <Return>=lastread, start with:")
  2635.   ELSE
  2636.     send(cr$+STR$(messages%)+" messages, <Return>=lastread, start with:")
  2637.   ENDIF
  2638.   CLR inp$
  2639.   input(1,5,32,inp$)
  2640.   IF inp$=""
  2641.     f%=lastmsg&
  2642.   ELSE
  2643.     f%=VAL(inp$)
  2644.   ENDIF
  2645.   IF f%<1
  2646.     f%=1
  2647.   ELSE IF f%>messages%
  2648.     f%=messages%
  2649.   ENDIF
  2650.   DEC f%
  2651.   dec!=FALSE
  2652.   '
  2653.   clr
  2654.   send("Press Space or P to pause, S to Stop")
  2655.   send(cr$+" #  From                 To                   Subject")
  2656.   send(cr$+STRING$(40,"-_")+cr$)
  2657.   DO WHILE (NOT abort!) AND (NOT hangup!)
  2658.     searchmsg(area|)
  2659.     send(STR$(f%)+SPACE$(4-LEN(STR$(f%))))
  2660.     IF LEN(from$)>20
  2661.       from$=LEFT$(from$,20)
  2662.     ENDIF
  2663.     send(from$+SPACE$(21-LEN(from$)))
  2664.     IF LEN(to$)>20
  2665.       to$=LEFT$(to$,20)
  2666.     ENDIF
  2667.     send(to$+SPACE$(21-LEN(to$)))
  2668.     IF LEN(subj$)>32
  2669.       subj$=LEFT$(subj$,32)
  2670.     ENDIF
  2671.     send(subj$+cr$)
  2672.     IF INP?(1) OR INP?(2)
  2673.       getchr(ch$)
  2674.       IF ch$=" " OR ch$="P"
  2675.         send(CHR$(13)+"*** Paused ***")
  2676.         getchr(ch$)
  2677.         send(CHR$(13))
  2678.       ENDIF
  2679.     ENDIF
  2680.   LOOP UNTIL f%=>messages%
  2681.   CLOSE #59
  2682.   send(cr$+"Press <RETURN>..."+CHR$(1))
  2683. RETURN
  2684. > PROCEDURE subject(VAR subject$)          !Ask Subject
  2685.   nomsg!=FALSE
  2686.   send(cr$+"Subject: ")
  2687.   input(1,75,32,subject$)
  2688.   IF subject$=""
  2689.     nomsg!=TRUE
  2690.   ENDIF
  2691. RETURN
  2692. > PROCEDURE to(VAR usr$)                   !Ask to
  2693.   REPEAT
  2694.     send(cr$+"To  :")
  2695.     CLR usr$
  2696.     input(2,74,32,usr$)
  2697.     IF usr$="All"
  2698.       found!=TRUE
  2699.     ELSE IF usr$="Sysop" OR LEN(usr$)=0
  2700.       usr$=sysop$
  2701.       found!=TRUE
  2702.     ELSE
  2703.       IF @newuser(usr$)>0
  2704.         found!=TRUE
  2705.       ENDIF
  2706.       CLOSE #99
  2707.     ENDIF
  2708.     IF found!=FALSE
  2709.       send(cr$+"This user does not exist, Another name? <Y/n>")
  2710.       CLR ch$
  2711.       menu("YN"+CHR$(13),ch$)
  2712.       IF ch$="N"
  2713.         nomsg!=TRUE
  2714.         EXIT IF TRUE
  2715.       ENDIF
  2716.     ELSE
  2717.       send(cr$+"To "+usr$+", correct? <Y/n>")
  2718.       CLR ch$
  2719.       menu("YN"+CHR$(13),ch$)
  2720.       IF ch$="N"
  2721.         found!=FALSE
  2722.       ENDIF
  2723.     ENDIF
  2724.   UNTIL found! OR hangup!
  2725. RETURN
  2726. > PROCEDURE from(VAR from$)                !Ask for alias if allowed
  2727.   IF LEN(alias$)
  2728.     send(cr$+"Do you want to use your alias? (y/N)")
  2729.     CLR ch$
  2730.     menu("YN"+CHR$(13),ch$)
  2731.     IF ch$="Y"
  2732.       from$=alias$
  2733.     ELSE
  2734.       from$=user$
  2735.     ENDIF
  2736.   ELSE
  2737.     from$=user$
  2738.   ENDIF
  2739. RETURN
  2740. '
  2741. > PROCEDURE open_header(nr|)               !Init MSG-Area
  2742.   CLOSE #59
  2743.   proc$="Open_Header"
  2744.   area_name$=STRING$(4-LEN(STR$(nr|)),"0")+STR$(nr|)
  2745.   OPEN "R",#59,msg_path$+area_name$+".HDR",216
  2746.   FIELD #59,36 AS m_from$,36 AS m_to$,72 AS m_subject$,20 AS m_time$
  2747.   FIELD #59,4 AT(*m_stamp%),4 AT(*m_offset%),2 AT(*m_reserv1&),2 AT(*m_reply&)
  2748.   FIELD #59,2 AT(*m_attributes&)
  2749.   FIELD #59,2 AT(*mailer1&),2 AT(*mailer2&),2 AT(*mailer3&),2 AT(*mailer4&)
  2750.   FIELD #59,2 AT(*mailer5&),2 AT(*mailer6&),2 AT(*mailer7&),2 AT(*mailer8&)
  2751.   FIELD #59,2 AT(*m_size&),2 AT(*m_rc&)
  2752.   FIELD #59,2 AT(*m_cost&)
  2753.   FIELD #59,2 AT(*m_ozone&),2 AT(*m_onet&),2 AT(*m_onode&),2 AT(*m_opoint&)
  2754.   FIELD #59,2 AT(*m_dzone&),2 AT(*m_dnet&),2 AT(*m_dnode&),2 AT(*m_dpoint&)
  2755.   number_msgs%=LOF(#59)/216
  2756. RETURN
  2757. > PROCEDURE init_date                      !Init Date (On Start)
  2758.   proc$="Init_Date"
  2759.   '
  2760.   DIM mnds%(12)  !Antal sekunder sedan b|rjan av ett †r per m†nad
  2761.   DIM mnd%(12)   !Antal dagar sedan b”rjan av †ret
  2762.   DIM mnd$(12)   !Namn p† m†nader
  2763.   DIM day$(7)    !Namn p† dagarna
  2764.   DIM fn$(100)
  2765.   '
  2766.   max_fn#=0
  2767.   LOCAL t%,d%
  2768.   mnd%(0)=0
  2769.   FOR t%=1 TO 12
  2770.     READ mnd%(t%)
  2771.     mnd%(t%)=mnd%(t%)+mnd%(t%-1)
  2772.     mnds%(t%)=mnd%(t%)*86400
  2773.   NEXT t%
  2774.   FOR t%=1 TO 12
  2775.     READ mnd$(t%)
  2776.   NEXT t%
  2777.   FOR t%=0 TO 6
  2778.     READ day$(t%)
  2779.   NEXT t%
  2780.   DATA 0,31,28,31,30,31,30,31,31,30,31,30
  2781.   DATA "Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
  2782.   DATA "Sun","Mon","Tue","Wed","Thu","Fri","Sat"
  2783.   '
  2784. RETURN
  2785. > PROCEDURE convert(r_msgs%)               !Read 1 header
  2786.   proc$="Convert()"
  2787.   GET #59,r_msgs%
  2788.   from$=CHAR{V:m_from$}
  2789.   to$=CHAR{V:m_to$}
  2790.   subj$=CHAR{V:m_subject$}
  2791.   datum$=CHAR{V:m_time$}
  2792.   stamp%=m_stamp%
  2793.   offset%=m_offset%
  2794.   attributes&=m_attributes&
  2795.   size&=m_size&
  2796.   ozone&=m_ozone&
  2797.   onet&=m_onet&
  2798.   onode&=m_onode&
  2799.   opoint&=m_opoint&
  2800.   dzone&=m_dzone&
  2801.   dnet&=m_dnet&
  2802.   dnode&=m_dnode&
  2803.   dpoint&=m_dpoint&
  2804. RETURN
  2805. > PROCEDURE delete(r_msgs%)                !Delete a mail (Not used yet)
  2806.   proc$="Delete()"
  2807.   m_attributes&=m_attributes& OR -1
  2808.   FOR j%=1 TO 14
  2809.     m_attributes&=BCLR(m_attributes&,j%)
  2810.   NEXT j%
  2811.   PUT #59,r_msgs%
  2812. RETURN
  2813. > PROCEDURE save_msg(d_zone&,d_net&,d_node&,d_point&,from$,to$,subject$,outdata$)
  2814.   IF EXIST(msg_path$+area_name$+".MSG")
  2815.     OPEN "A",#60,msg_path$+area_name$+".MSG"
  2816.   ELSE
  2817.     OPEN "O",#60,msg_path$+area_name$+".MSG"
  2818.   ENDIF
  2819.   '
  2820.   INC number_msgs%
  2821.   '
  2822.   LSET m_from$=from$+CHR$(0)
  2823.   '
  2824.   LSET m_to$=to$+CHR$(0)
  2825.   '
  2826.   LSET m_subject$=subject$+CHR$(0)
  2827.   '
  2828.   LSET m_time$=@dates$+CHR$(0)
  2829.   '
  2830.   t_stamp%=@gmts !Not needed, Pack stamps it
  2831.   ' t_stamp%=0
  2832.   '
  2833.   m_offset%=LOF(#60)+1 !Lenght of netmails .MSG before saving outfile
  2834.   '
  2835.   m_reserv1&=0
  2836.   '
  2837.   m_reply&=0
  2838.   '
  2839.   m_attributes&=0
  2840.   IF private!
  2841.     m_attributes&=BSET(m_attributes&,0) !Private
  2842.   ENDIF
  2843.   '  m_attributes&=BSET(m_attributes&,7) !Kill/Sent
  2844.   m_attributes&=BSET(m_attributes&,8) !Local
  2845.   '
  2846.   '
  2847.   m_mailer1&=0 !8 reserved fields, Of Limits!
  2848.   m_mailer2&=0
  2849.   m_mailer3&=0
  2850.   m_mailer4&=0
  2851.   m_mailer5&=0
  2852.   m_mailer6&=0
  2853.   m_mailer7&=0
  2854.   m_mailer8&=0
  2855.   '
  2856.   m_size&=LEN(outdata$) !Lenght of outfile
  2857.   '
  2858.   m_rc&=0
  2859.   '
  2860.   m_cost&=0
  2861.   '
  2862.   m_ozone&=my_zone&  !Origin
  2863.   m_onet&=my_net&
  2864.   m_onode&=my_node&
  2865.   m_opoint&=my_point&
  2866.   '
  2867.   m_dzone&=d_zone&  !Destination
  2868.   m_dnet&=d_net&
  2869.   m_dnode&=d_node&
  2870.   m_dpoint&=d_point&
  2871.   '
  2872.   PUT #59,number_msgs%
  2873.   PRINT #60,outdata$
  2874.   CLOSE #60
  2875. RETURN
  2876. '
  2877. ' -----------------------------------------< Door Functions
  2878. '
  2879. > PROCEDURE execute(file$)
  2880.   LOCAL ext$
  2881.   IF INSTR(file$," ")
  2882.     split(file$)
  2883.     file$=part1$
  2884.     cl$=part2$
  2885.   ENDIF
  2886.   IF INSTR(file$,".")
  2887.     ext$=RIGHT$(file$,RINSTR(file$,"."))
  2888.     IF ext$=".DOR"
  2889.       dor_parser(file$)
  2890.     ELSE
  2891.       e%=@run(file$,cl$)
  2892.       IF e%
  2893.         log("Error "+STR$(e%)+" from "+file$)
  2894.       ENDIF
  2895.     ENDIF
  2896.   ENDIF
  2897. RETURN
  2898. > PROCEDURE dor_parser(file$)                    !Tempor„r l”sning
  2899.   '  IF EXIST(dordir$+file$)
  2900.   game_1
  2901.   '    OPEN "I",#1,dordir$+file$
  2902.   '
  2903.   '
  2904.   '
  2905.   '   CLOSE #1
  2906.   ' ELSE
  2907.   '  send(cr$+"File doesn't exist!")
  2908.   '  log(file$+" doesn't exist!")
  2909.   ' ENDIF
  2910. RETURN
  2911. > PROCEDURE game_1
  2912.   CLR p.path$,p.name$,part1$,part2$
  2913.   @modem_stat
  2914.   IF dcd!
  2915.     a$=door_1$
  2916.   ELSE
  2917.     a$=door_1l$
  2918.   ENDIF
  2919.   split(a$)
  2920.   split_path(part1$)
  2921.   old_dir$=@cwd$
  2922.   ~@chd(p.path$)
  2923.   write_forem.dat
  2924.   e%=@run(p.name$,part2$)
  2925.   IF e%
  2926.     log("Error "+STR$(e%)+" from "+p.name$)
  2927.   ENDIF
  2928.   ~@chd(old_dir$)
  2929. RETURN
  2930. > PROCEDURE write_forem.dat                !Write forem.dat
  2931.   LOCAL f%
  2932.   '
  2933.   fd$=STRING$(3882,0)                   ! Empty first
  2934.   MID$(fd$,3465)=LEFT$(UPPER$(pass$),13)+CHR$(0)       ! Users password
  2935.   MID$(fd$,3478)=LEFT$(UPPER$(user$),31)+CHR$(0)      ! His name
  2936.   MID$(fd$,3509)=RIGHT$(UPPER$(phone$),13)+CHR$(0)    ! Phone number
  2937.   MID$(fd$,3522)=MKI$(25)               ! Age
  2938.   MID$(fd$,3524)=CHR$(255)              ! Line Feeds on/off
  2939.   MID$(fd$,3525)=MKI$(1)                ! Computer Type
  2940.   '
  2941.   MID$(fd$,3629)=MKI$(30)               ! Time Left today
  2942.   MID$(fd$,3631)=MKI$(2)                ! Max Calls
  2943.   MID$(fd$,3633)=MKI$(1)                ! Calls remaining
  2944.   MID$(fd$,3637)=MKI$(30)               ! Time Left this call
  2945.   ' MID$(fd$,3629)=MKI$(FN timeleft)      ! Time Left today
  2946.   ' MID$(fd$,3631)=MKI$(2)                ! Max Calls
  2947.   ' MID$(fd$,3633)=MKI$(1)                ! Calls remaining
  2948.   ' MID$(fd$,3637)=MKI$(FN timeleft)      ! Time Left this call
  2949.   '
  2950.   MID$(fd$,3837)=LEFT$(UPPER$(city$),21)+CHR$(0) ! Users city
  2951.   '
  2952.   CLOSE #1
  2953.   OPEN "O",#1,"forem.dat"
  2954.   PRINT #1,fd$;
  2955.   CLOSE #1
  2956.   '
  2957. RETURN
  2958. '
  2959. ' -----------------------------------------< Misc
  2960. '
  2961. > PROCEDURE read_bbs.cfg
  2962.   IF EXIST(scs$+"CONF\BBS.CFG")
  2963.     OPEN "I",#1,scs$+"CONF\BBS.CFG"
  2964.     REPEAT
  2965.       LINE INPUT #1,a$
  2966.       b$=TRIM$(a$)
  2967.       a$=UPPER$(TRIM$(a$))
  2968.       split(a$)
  2969.       IF LEFT$(part2$)="~"
  2970.         part2$=LEFT$(scs$,LEN(scs$)-1)+MID$(part2$,2)
  2971.       ENDIF
  2972.       IF part1$="SPEED"
  2973.         speed&=VAL(part2$)
  2974.       ELSE IF part1$="SPEEDLOCK"
  2975.         speedlock!=TRUE
  2976.       ELSE IF part1$="M_INIT"
  2977.         m.init1$=part2$
  2978.       ELSE IF part1$="M_INIT2"
  2979.         m.init2$=part2$
  2980.       ELSE IF part1$="M_BUSY"
  2981.         m.busy$=part$
  2982.       ELSE IF part1$="M_HANGUP"
  2983.         m.hangup$=part2$
  2984.       ELSE IF part1$="M_RESET"
  2985.         m.reset$=part2$
  2986.         '
  2987.       ELSE IF part1$="N_U_LEVEL"
  2988.         newuserlevel|=VAL(part2$)
  2989.       ELSE IF part1$="N_U_FLAG"
  2990.         newuserflag%=VAL(part2$)
  2991.         '
  2992.       ELSE IF part1$="SYSOP"
  2993.         split(b$)
  2994.         sysop$=part2$
  2995.         '
  2996.       ELSE IF part1$="SHELL"
  2997.         shell$=part2$
  2998.       ELSE IF part1$="DOORS"
  2999.         dordir$=part2$
  3000.       ELSE IF part1$="MEDITOR"
  3001.         editor$=part2$
  3002.       ELSE IF part1$="TEDITOR"
  3003.         text_editor$=part2$
  3004.       ELSE IF part1$="TEXT"
  3005.         text_path$=part2$
  3006.       ELSE IF part1$="MENU"
  3007.         menu_path$=part2$
  3008.       ELSE IF part1$="MSG"
  3009.         msg_path$=part2$
  3010.       ELSE IF part1$="FILES"
  3011.         file_path$=part2$
  3012.       ELSE IF part1$="X_DOWN"
  3013.         x_down$=part2$
  3014.       ELSE IF part1$="K_DOWN"
  3015.         k_down$=part2$
  3016.       ELSE IF part1$="Y_DOWN"
  3017.         y_down$=part2$
  3018.       ELSE IF part1$="Z_DOWN"
  3019.         z_down$=part2$
  3020.       ELSE IF part1$="X_UP"
  3021.         x_up$=part2$
  3022.       ELSE IF part1$="K_UP"
  3023.         k_up$=part2$
  3024.       ELSE IF part1$="Y_UP"
  3025.         y_up$=part2$
  3026.       ELSE IF part1$="Z_UP"
  3027.         z_up$=part2$
  3028.       ELSE IF part1$="ZONE"
  3029.         my_zone&=VAL(part2$)
  3030.       ELSE IF part1$="NET"
  3031.         my_net&=VAL(part2$)
  3032.       ELSE IF part1$="NODE"
  3033.         my_node&=VAL(part2$)
  3034.       ELSE IF part1$="POINT"
  3035.         my_point&=VAL(part2$)
  3036.       ELSE IF part1$="SCREENSAVER"
  3037.         screensaver|=VAL(part2$)
  3038.       ELSE IF part1$="TIMEOUT"
  3039.         timeout|=VAL(part2$)
  3040.       ELSE
  3041.         IF LEN(part1$)
  3042.           IF (LEFT$(part1$)<>";") AND (LEFT$(part1$)<>"#")
  3043.             PRINT "Unknown Config-Line <";b$;">"
  3044.           ENDIF
  3045.         ENDIF
  3046.       ENDIF
  3047.     UNTIL EOF(#1)
  3048.   ELSE
  3049.     PRINT "No CONF\BBS.CFG"
  3050.     EDIT
  3051.   ENDIF
  3052.   CLOSE #1
  3053. RETURN
  3054. > PROCEDURE setupvars                      !Init a lot of stuff at the start
  3055.   snoop!=TRUE
  3056.   keyclick(FALSE)                                     ! No cursor-noise
  3057.   keyrepeat(TRUE)
  3058.   bell(TRUE)                                          ! 'Pling!!!' on
  3059.   cr$=CHR$(13)+CHR$(10)                               ! <Cr> + <Lf>
  3060.   '
  3061.   lower$=SPACE$(256)                                  ! Creates a string with no
  3062.   FOR f#=0 TO 255                                      ! capitals, but normal
  3063.     POKE V:lower$+f#,f#                                 ! Much faster than Let
  3064.   NEXT f#                                              ! or 'Lower$=lower$+....
  3065.   FOR f#=0 TO 255
  3066.     IF CHR$(f#)<>UPPER$(CHR$(f#))
  3067.       POKE V:lower$+ASC(UPPER$(CHR$(f#))),f#            ! Much faster than mid$,
  3068.     ENDIF                                             ! left$ & right$.
  3069.   NEXT f#
  3070.   '
  3071.   DIM msg$(100)
  3072.   '
  3073.   DIM free%(16)
  3074. RETURN
  3075. '
  3076. > PROCEDURE bell(option|)                  !Bell on/off
  3077.   IF option|
  3078.     option|=4
  3079.   ENDIF
  3080.   SPOKE &H484,(PEEK(&H484) AND 251) OR option|
  3081. RETURN
  3082. > PROCEDURE chkend(ch#)                     !Check for CHR$(10) at EOF
  3083.   LOCAL loc#                                           ! This routine checks if
  3084.   loc#=LOC(#ch#)                                        ! the file can be read
  3085.   SEEK #ch#,MAX(0,LOF(#ch#)-1)                          ! with input. It can if
  3086.   IF EOF(#ch#)=FALSE                                   ! the last byte is
  3087.     IF INP(#ch#)<>10                                   ! Chr$(10). Else it'll
  3088.       OUT #ch#,10                                      ! produce an error.
  3089.     ENDIF                                             ! I don't know if this is
  3090.   ENDIF                                               ! The best way solving
  3091.   SEEK #ch#,loc#                                        ! this prob. but it works.
  3092. RETURN
  3093. > PROCEDURE cursor(option|)                !Cursor on/off (VT52)
  3094.   ' Only for Atari
  3095.   IF option|
  3096.     send("e")
  3097.   ELSE
  3098.     send("f")
  3099.   ENDIF
  3100. RETURN
  3101. > PROCEDURE keyclick(option|)              !Click on/off
  3102.   IF option|
  3103.     option|=1
  3104.   ENDIF
  3105.   SPOKE &H484,(PEEK(&H484) AND 254) OR option|
  3106. RETURN
  3107. > PROCEDURE keyrepeat(option|)             !Key Repeat On/off
  3108.   IF option|
  3109.     option|=2
  3110.   ENDIF
  3111.   SPOKE &H484,(PEEK(&H484) AND 253) OR option|
  3112. RETURN
  3113. > PROCEDURE split_path(a$)                 !Split Path as Path$ and Name$
  3114.   IF INSTR(a$,"\")
  3115.     p.path$=TRIM$(LEFT$(a$,RINSTR(a$,"\")))
  3116.     p.name$=TRIM$(MID$(a$,RINSTR(a$,"\")+1))
  3117.   ELSE
  3118.     p.path$=""
  3119.     p.name$=a$
  3120.   ENDIF
  3121. RETURN
  3122. > PROCEDURE jump_to_dos
  3123.   PRINT " o Jumping to Dos..."
  3124.   old_dir$=@cwd$
  3125.   split_path(shell$)
  3126.   ~@chd(p.path$)
  3127.   e%=@run(p.name$,"")
  3128.   ~@chd(old_dir$)
  3129. RETURN
  3130. '
  3131. > PROCEDURE play(a$,mus$)                     !Play Xbios 32 Music
  3132.   LOCAL do$,sluk$
  3133.   send(a$+cr$)
  3134.   IF EXIST(mus$)=FALSE AND EXIST(mus$+".MUS")
  3135.     mus$=mus$+".MUS"
  3136.   ENDIF
  3137.   IF EXIST(mus$)
  3138.     CLOSE #15
  3139.     OPEN "I",#15,mus$
  3140.     do$=INPUT$(MIN(LOF(#15),32766),#15)+CHR$(0)
  3141.     CLOSE #15
  3142.     sluk$=MKI$(0)
  3143.     VOID XBIOS(32,L:VARPTR(sluk$))
  3144.     SOUND 0,0
  3145.     SOUND 1,0
  3146.     SOUND 2,0
  3147.     VOID XBIOS(32,L:VARPTR(sluk$))
  3148.     SOUND 0,0
  3149.     SOUND 1,0
  3150.     SOUND 2,0
  3151.     VOID XBIOS(32,L:VARPTR(do$))
  3152.   ENDIF
  3153. RETURN
  3154. '
  3155. > PROCEDURE wait(sec%)                     !Wait for sec%*50 secounds
  3156.   sec%=TIMER+sec%
  3157.   REPEAT
  3158.   UNTIL TIMER>sec%
  3159. RETURN
  3160. > PROCEDURE wrap(VAR wrap$)                !Wrap text longer then 80 chr
  3161.   LOCAL rest$,found#
  3162.   REPEAT
  3163.     IF LEN(wrap$)>80
  3164.       IF RINSTR(LEFT$(wrap$,80)," ")
  3165.         rest$=rest$+LEFT$(wrap$,RINSTR(LEFT$(wrap$,80)," ")-1)+cr$
  3166.         wrap$=MID$(wrap$,RINSTR(LEFT$(wrap$,80)," ")+1)
  3167.       ELSE
  3168.         rest$=rest$+LEFT$(wrap$,80)
  3169.         wrap$=MID$(wrap$,81)
  3170.       ENDIF
  3171.     ELSE
  3172.       rest$=rest$+wrap$
  3173.       CLR wrap$
  3174.     ENDIF
  3175.     REPEAT
  3176.       IF LEFT$(wrap$)=" "
  3177.         wrap$=MID$(wrap$,2)
  3178.       ENDIF
  3179.     UNTIL LEFT$(wrap$)<>" "
  3180.   UNTIL wrap$=""
  3181.   wrap$=rest$
  3182. RETURN
  3183. '
  3184. > PROCEDURE log(a$)                        !Logging
  3185.   IF EXIST("BBS.LOG")
  3186.     OPEN "A",#50,"BBS.LOG"
  3187.   ELSE
  3188.     OPEN "O",#50,"BBS.LOG"
  3189.     PRINT #50," - SCS BBS Logfile, Created ";DATE$;" at ";TIME$
  3190.     PRINT #50
  3191.   ENDIF
  3192.   PRINT #50,LEFT$(DATE$,5);" ";LEFT$(TIME$,5);" : BBS ";a$
  3193.   CLOSE #50
  3194. RETURN
  3195. > PROCEDURE statusline                     !Lastuser Lines
  3196.   lastuser$=user$
  3197.   IF LEN(user$)>22
  3198.     lastuser$=LEFT$(lastuser$)+" "+MID$(lastuser$,INSTR(lastuser$," "))
  3199.     IF LEN(lastuser$)>22
  3200.       lastuser$=LEFT$(lastuser$,22)
  3201.     ENDIF
  3202.   ELSE IF LEN(lastuser$)<22
  3203.     lastuser$=lastuser$+SPACE$(22-LEN(lastuser$))
  3204.   ENDIF
  3205.   last_time$=LEFT$(last_time$,2)+":"+RIGHT$(last_time$,2)
  3206.   statusline$=" "+lastuser$+last_time$+" "+LEFT$(TIME$,5)+" "
  3207.   '
  3208.   sec$=STR$(level|)
  3209.   IF LEN(sec$)<3
  3210.     sec$=sec$+SPACE$(3-LEN(sec$))
  3211.   ENDIF
  3212.   statusline$=statusline$+sec$+" "
  3213.   '
  3214.   cred$=STR$(credits&)
  3215.   IF LEN(cred$)<5
  3216.     cred$=cred$+SPACE$(5-LEN(credit$))
  3217.   ENDIF
  3218.   statusline$=statusline$+cred$+" "
  3219.   '
  3220.   pmsg$=STR$(posted_msgs&)
  3221.   IF LEN(pmsg$)<4
  3222.     pmsg$=pmsg$+SPACE$(4-LEN(pmsg$))
  3223.   ENDIF
  3224.   statusline$=statusline$+pmsg$+" "
  3225.   '
  3226.   call$=STR$(calls&)
  3227.   IF LEN(call$)<5
  3228.     call$=call$+SPACE$(5-LEN(call$))
  3229.   ELSE IF LEN(call$)>5
  3230.     call$=LEFT$(call$,4)+"-"
  3231.   ENDIF
  3232.   statusline$=statusline$+call$+" "
  3233.   '
  3234.   ud$=STR$(down_today&)+"/"+STR$(down_kb&)+"/"+STR$(upl_kb&)
  3235.   IF LEN(ud$)<13
  3236.     ud$=ud$+SPACE$(13-LEN(ud$))
  3237.   ELSE IF LEN(ud$)>13
  3238.     ud$=LEFT$(ud$,12)+"-"
  3239.   ENDIF
  3240.   statusline$=statusline$+ud$+" "
  3241.   '
  3242.   statusline$=statusline$+"("
  3243.   IF error!
  3244.     statusline$=statusline$+"!"
  3245.   ELSE
  3246.     statusline$=statusline$+"-"
  3247.   ENDIF
  3248.   IF s.yell!
  3249.     statusline$=statusline$+"Y"
  3250.   ELSE
  3251.     statusline$=statusline$+"-"
  3252.   ENDIF
  3253.   IF s.msgs!
  3254.     statusline$=statusline$+"M"
  3255.   ELSE
  3256.     statusline$=statusline$+"-"
  3257.   ENDIF
  3258.   IF net!
  3259.     statusline$=statusline$+"N"
  3260.   ELSE
  3261.     statusline$=statusline$+"-"
  3262.   ENDIF
  3263.   IF echo!
  3264.     statusline$=statusline$+"E"
  3265.   ELSE
  3266.     statusline$=statusline$+"-"
  3267.   ENDIF
  3268.   IF s.dc!
  3269.     statusline$=statusline$+"D"
  3270.   ELSE
  3271.     statusline$=statusline$+"-"
  3272.   ENDIF
  3273.   statusline$=statusline$+")"
  3274.   '
  3275.   INSERT statusline$(0)=statusline$
  3276.   OPEN "O",#1,"CONF\STATLINE.BBS"
  3277.   STORE #1,statusline$()
  3278.   CLOSE #1
  3279.   '
  3280.   CLR statusline$
  3281. RETURN
  3282. '
  3283. ' -----------------------------------------< Modem Routins
  3284. '
  3285. > PROCEDURE clr                            !Send CLS
  3286.   IF BTST(attribut|,0)
  3287.     send2(" E "+CHR$(13))                              ! Clear both IBM and Atari
  3288.   ELSE
  3289.     send2(cr$+cr$+cr$)
  3290.   ENDIF
  3291. RETURN
  3292. > PROCEDURE cat(file$,pause$,break$)       !Send file to modem and screen
  3293.   LOCAL cat$,break!,f%
  3294.   break$=UPPER$(break$)
  3295.   IF EXIST(file$)
  3296.   ELSE IF EXIST(file$+".ASC")
  3297.     file$=file$+".ASC"
  3298.   ELSE IF EXIST(text_path$+file$)
  3299.     file$=text_path$+file$
  3300.   ELSE IF EXIST(text_path$+file$+".ASC")
  3301.     file$=text_path$+file$+".ASC"
  3302.   ENDIF
  3303.   IF EXIST(file$)
  3304.     CLOSE #2
  3305.     OPEN "I",#2,file$
  3306.     cat$=INPUT$(LOF(#2),#2)
  3307.     CLOSE #2
  3308.     FOR f%=1 TO LEN(cat$)
  3309.       a|=ASC(MID$(cat$,f%,1))
  3310.       IF INP?(1) OR INP?(2)
  3311.         getchr(ch$)
  3312.         IF INSTR(pause$,UPPER$(ch$))
  3313.           getchr(ch$)
  3314.         ELSE IF INSTR(break$,UPPER$(ch$))
  3315.           break!=TRUE
  3316.         ENDIF
  3317.       ENDIF
  3318.       EXIT IF hangup!
  3319.       EXIT IF break!
  3320.       send(CHR$(a|))
  3321.     NEXT f%
  3322.   ELSE
  3323.     PRINT
  3324.     PRINT "o ";file$;" doesn't exist"
  3325.   ENDIF
  3326. RETURN
  3327. > PROCEDURE getchr(VAR ch$)                !Get 1 chr from modem or consol (DCD)
  3328.   LOCAL timeout!,timeout%,timewarn!,t.timeout|
  3329.   key_pressed!=FALSE
  3330.   REPEAT
  3331.     timeout%=TIMER
  3332.     t.timeout|=timeout|
  3333.     REPEAT
  3334.       @modem_stat
  3335.       hangup!=(NOT dcd!) AND (NOT local!)
  3336.       IF TIMER-timeout%>(12000*t.timeout|)
  3337.         IF timewarn!=FALSE
  3338.           send(cr$+cr$+"Warning! You will be logged of in 1 minute if you dont show any sign of life!"+cr$+cr$)
  3339.           t.timeout|=1
  3340.           timeout%=TIMER
  3341.           timewarn!=TRUE
  3342.         ELSE
  3343.           timeout!=TRUE
  3344.         ENDIF
  3345.       ENDIF
  3346.     UNTIL (INP?(1) OR INP?(2)) OR hangup! OR timeout!
  3347.     IF hangup!
  3348.       PRINT
  3349.       PRINT " o Dropped Carrier!"
  3350.     ELSE IF timeout!
  3351.       send(cr$+"Timeout! Bye.")
  3352.       log(user$+" Logged off due to inactivity.")
  3353.       hangup!=TRUE
  3354.     ENDIF
  3355.     EXIT IF hangup!
  3356.     IF INP?(1)
  3357.       ch$=CHR$(INP(1))
  3358.       key_pressed!=TRUE
  3359.     ELSE IF INP?(2)
  3360.       i#=INP(2)
  3361.       SELECT i#
  3362.       CASE 163      !Alt H
  3363.         hangup!=TRUE
  3364.       CASE 165      !Alt-J
  3365.         send(cr$+"Sysop ha jumped to dos, please wait...")
  3366.         jump_to_dos
  3367.         send(cr$+"Back from dos, Hi again!")
  3368.       CASE 196      ! F10
  3369.         chat
  3370.       CASE 225      !Undo
  3371.         EDIT
  3372.       CASE 226      !Help
  3373.         PRINT
  3374.         PRINT " o ";user$;" (";alias$;") from ";city$;" in ";baud$;" baud"
  3375.       DEFAULT
  3376.         key_pressed!=TRUE
  3377.         ch$=CHR$(i#)
  3378.       ENDSELECT
  3379.     ENDIF
  3380.   UNTIL key_pressed!
  3381. RETURN
  3382. > PROCEDURE input(type|,max%,del%,VAR input$) !Get line of text
  3383.   '
  3384.   '
  3385.   '  Type 0  Password (Hide output)
  3386.   '  Type 1  Normal input
  3387.   '  Type 2  Name
  3388.   '  Type 3  All upper
  3389.   '  Type 4  Numbers
  3390.   '  Type 5  Wordwrap
  3391.   '
  3392.   '   Max%  Lenght of string
  3393.   '
  3394.   '   Del%  Char to overwite with
  3395.   '
  3396.   '   Input$  Answer String
  3397.   '
  3398.   LOCAL ch$,xcrs%
  3399.   CLR wordwrap!
  3400.   IF type|=0
  3401.     CLR input$
  3402.   ELSE
  3403.     send(input$)
  3404.     xcrs%=LEN(input$)
  3405.   ENDIF
  3406.   REPEAT
  3407.     getchr(ch$)
  3408.     EXIT IF hangup!
  3409.     IF ASC(ch$)<>13  !Om ej return
  3410.       '                                      vvvv -- Radera --- vvv
  3411.       IF ch$=CHR$(8) !Om backspace radera...
  3412.         IF xcrs%>0
  3413.           SELECT type|
  3414.           CASE 0 !Password
  3415.             send(CHR$(8)+STRING$(LEN(MID$(input$,xcrs%+1)),".")+CHR$(del%)+STRING$(LEN(MID$(input$,xcrs%)),8))
  3416.             input$=LEFT$(input$,MAX(0,xcrs%-1))+MID$(input$,xcrs%+1)
  3417.             DEC xcrs%
  3418.           CASE 2 !Namn osv
  3419.             input$=LEFT$(input$,MAX(0,xcrs%-1))+MID$(input$,xcrs%+1)
  3420.             IF input$>"" AND input$<>" "
  3421.               POKE V:input$,ASC(UPPER$(input$))
  3422.               FOR f%=V:input$+1 TO V:input$+LEN(input$)-1
  3423.                 IF PEEK(f%-1)=32 OR PEEK(f%-1)=45 OR PEEK(f%-1)=46 OR PEEK(f%-1)=95
  3424.                   POKE f%,ASC(UPPER$(CHR$(PEEK(f%))))
  3425.                 ELSE
  3426.                   POKE f%,ASC(MID$(lower$,PEEK(f%)+1))
  3427.                 ENDIF
  3428.               NEXT f%
  3429.             ENDIF
  3430.             send(CHR$(8)+MID$(input$,xcrs%)+CHR$(del%)+STRING$(LEN(MID$(input$,xcrs%))+1,8))
  3431.             DEC xcrs%
  3432.           DEFAULT
  3433.             send(CHR$(8)+MID$(input$,xcrs%+1)+CHR$(del%)+STRING$(LEN(MID$(input$,xcrs%)),8))
  3434.             input$=LEFT$(input$,MAX(0,xcrs%-1))+MID$(input$,xcrs%+1)
  3435.             DEC xcrs%
  3436.           ENDSELECT
  3437.         ENDIF
  3438.         '                   vvvv --- Special Chars ---- vvvv
  3439.       ELSE IF ch$=CHR$(27)  ! --- Om Escape radera string
  3440.         send(STRING$(LEN(input$),8)+STRING$(LEN(input$),32)+STRING$(LEN(input$),8))
  3441.         CLR input$
  3442.         CLR xcrs%
  3443.       ELSE IF ch$=CHR$(200) ! --- Om Pil upp
  3444.       ELSE IF ch$=CHR$(203) ! --- Om pil left (<-)
  3445.         IF xcrs%>0
  3446.           DEC xcrs%
  3447.           send(CHR$(8))
  3448.         ENDIF
  3449.       ELSE IF ch$=CHR$(205) ! --- Om pil right (->) (Atari Only)
  3450.         IF xcrs%<LEN(input$)
  3451.           INC xcrs%
  3452.           send(CHR$(27)+"C")
  3453.         ENDIF
  3454.       ELSE IF ch$=CHR$(208) ! --- Om pil ner
  3455.         ' ------------------------------------
  3456.       ELSE                  !Add string
  3457.         SELECT type|
  3458.         CASE 0
  3459.           IF ch$>CHR$(31)
  3460.             IF xcrs%<max%
  3461.               INC xcrs%
  3462.               send("."+STRING$(LEN(MID$(input$,xcrs%)),".")+STRING$(LEN(MID$(input$,xcrs%)),8))
  3463.               input$=UPPER$(LEFT$(LEFT$(input$,MAX(0,xcrs%-1))+ch$+MID$(input$,xcrs%),max%))
  3464.             ELSE
  3465.               input$=UPPER$(LEFT$(LEFT$(input$,MAX(0,xcrs%-1)),max%-1)+ch$)
  3466.             ENDIF
  3467.           ENDIF
  3468.         CASE 1
  3469.           IF ch$>CHR$(31)
  3470.             IF xcrs%<max% ! --- While not max lenght
  3471.               INC xcrs%
  3472.               input$=LEFT$(LEFT$(input$,MAX(0,xcrs%-1))+ch$+MID$(input$,xcrs%),max%)
  3473.               send(MID$(input$,xcrs%)+STRING$(LEN(MID$(input$,xcrs%+1)),8))
  3474.             ELSE          ! --- Else dont make string longer
  3475.               input$=LEFT$(LEFT$(input$,MAX(0,xcrs%-1)),max%-1)+ch$
  3476.               send(CHR$(8)+ch$)
  3477.             ENDIF
  3478.           ENDIF
  3479.         CASE 2
  3480.           IF ch$>CHR$(31)
  3481.             IF xcrs%<max%
  3482.               INC xcrs%
  3483.               input$=LEFT$(LEFT$(input$,MAX(0,xcrs%-1))+ch$+MID$(input$,xcrs%),max%)
  3484.               IF input$>"" AND input$<>" "
  3485.                 POKE V:input$,ASC(UPPER$(input$))
  3486.                 FOR f%=V:input$+1 TO V:input$+LEN(input$)-1
  3487.                   IF PEEK(f%-1)=32 OR PEEK(f%-1)=45 OR PEEK(f%-1)=46 OR PEEK(f%-1)=95
  3488.                     POKE f%,ASC(UPPER$(CHR$(PEEK(f%))))
  3489.                   ELSE
  3490.                     POKE f%,ASC(MID$(lower$,PEEK(f%)+1))
  3491.                   ENDIF
  3492.                 NEXT f%
  3493.               ENDIF
  3494.               send(MID$(input$,xcrs%)+STRING$(LEN(MID$(input$,xcrs%+1)),8))
  3495.             ELSE
  3496.               input$=LEFT$(LEFT$(input$,MAX(0,xcrs%-1)),max%-1)+ch$
  3497.               IF input$>"" AND input$<>" "
  3498.                 POKE V:input$,ASC(UPPER$(input$))
  3499.                 FOR f%=V:input$+1 TO V:input$+LEN(input$)-1
  3500.                   IF PEEK(f%-1)=32 OR PEEK(f%-1)=45 OR PEEK(f%-1)=46 OR PEEK(f%-1)=95
  3501.                     POKE f%,ASC(UPPER$(CHR$(PEEK(f%))))
  3502.                   ELSE
  3503.                     POKE f%,ASC(MID$(lower$,PEEK(f%)+1))
  3504.                   ENDIF
  3505.                 NEXT f%
  3506.               ENDIF
  3507.               send(CHR$(8)+RIGHT$(input$))
  3508.             ENDIF
  3509.           ENDIF
  3510.         CASE 3
  3511.           IF ch$>CHR$(31)
  3512.             IF xcrs%<max%
  3513.               INC xcrs%
  3514.               input$=LEFT$(UPPER$(LEFT$(input$,MAX(0,xcrs%-1))+ch$+MID$(input$,xcrs%)),max%)
  3515.               send(MID$(input$,xcrs%)+STRING$(LEN(MID$(input$,xcrs%+1)),8))
  3516.             ELSE
  3517.               input$=LEFT$(UPPER$(LEFT$(input$,MAX(0,xcrs%-1))),MAX(0,max%-1))+ch$
  3518.               send(CHR$(8)+UPPER$(ch$))
  3519.             ENDIF
  3520.           ENDIF
  3521.         CASE 4
  3522.           IF ch$>"/" AND ch$<":" OR ch$=" "
  3523.             IF xcrs%<max%
  3524.               INC xcrs%
  3525.               input$=LEFT$(LEFT$(input$,MAX(0,xcrs%-1))+ch$+MID$(input$,xcrs%),max%)
  3526.               send(MID$(input$,xcrs%)+STRING$(LEN(MID$(input$,xcrs%+1)),8))
  3527.             ELSE
  3528.               input$=LEFT$(LEFT$(input$,MAX(0,xcrs%-1)),MAX(0,max%-1))+ch$
  3529.               send(CHR$(8)+ch$)
  3530.             ENDIF
  3531.           ENDIF
  3532.         CASE 5 !wordwrap!
  3533.           IF ch$>CHR$(31)
  3534.             IF xcrs%<max%
  3535.               INC xcrs%
  3536.               input$=LEFT$(LEFT$(input$,MAX(0,xcrs%-1))+ch$+MID$(input$,xcrs%),max%+1)
  3537.               send(MID$(input$,xcrs%)+STRING$(LEN(MID$(input$,xcrs%+1)),8))
  3538.             ELSE
  3539.               INC xcrs%
  3540.               input$=LEFT$(LEFT$(input$,MAX(0,xcrs%-1))+ch$+MID$(input$,xcrs%),max%+1)
  3541.               wordwrap!=TRUE
  3542.             ENDIF
  3543.           ENDIF
  3544.         ENDSELECT
  3545.       ENDIF
  3546.     ENDIF
  3547.   UNTIL ASC(ch$)=13 OR wordwrap! OR (type|=5 AND ch$=CHR$(3))
  3548. RETURN
  3549. > PROCEDURE menu(option$,VAR ch$)          !Use for hotkeys
  3550.   option$=UPPER$(option$)                             ! Wait until one of chars
  3551.   DO                                                  ! in option$ pressed.
  3552.     ch$=UPPER$(ch$)
  3553.     EXIT IF INSTR(option$,ch$) OR option$="" OR hangup!
  3554.     getchr(ch$)
  3555.   LOOP
  3556. RETURN
  3557. '
  3558. > PROCEDURE send(send$)                    !Send line to modem/screen
  3559.   LOCAL send%,i|
  3560.   IF LEN(send$)
  3561.     FOR send%=1 TO LEN(send$)
  3562.       i|=ASC(MID$(send$,send%,1))
  3563.       SELECT i|
  3564.       CASE 1
  3565.         REPEAT
  3566.           getchr(ch$)
  3567.         UNTIL ch$=CHR$(13)
  3568.       CASE 10
  3569.         IF more!
  3570.           INC more%
  3571.           IF more%=screenlenght|-1
  3572.             getchr(ch$)
  3573.           ENDIF
  3574.         ENDIF
  3575.         send2(CHR$(10))
  3576.       CASE 12
  3577.         clr
  3578.       CASE "^"
  3579.         reverse
  3580.       DEFAULT
  3581.         IF NOT local!
  3582.           REPEAT
  3583.             @modem_stat
  3584.           UNTIL OUT?(1) OR (NOT dcd!)
  3585.           OUT 1,i|
  3586.         ENDIF
  3587.         OUT 2,i|
  3588.       ENDSELECT
  3589.     NEXT send%
  3590.   ENDIF
  3591. RETURN
  3592. > PROCEDURE send2(s$)                    !Send line to modem/screen
  3593.   IF LEN(s$)
  3594.     FOR s%=1 TO LEN(s$)
  3595.       s|=ASC(MID$(s$,s%,1))
  3596.       IF NOT local!
  3597.         REPEAT
  3598.           @modem_stat
  3599.         UNTIL OUT?(1) OR (NOT dcd!)
  3600.         OUT 1,s|
  3601.       ENDIF
  3602.       OUT 2,s|
  3603.     NEXT s%
  3604.   ENDIF
  3605. RETURN
  3606. > PROCEDURE reverse
  3607.   IF reverse!
  3608.     reverse!=FALSE
  3609.     SELECT graphics|
  3610.     CASE 0 !Ascii
  3611.     CASE 1 !VT52 mono
  3612.       send2(CHR$(27)+"q")
  3613.     CASE 2 !VT52 Color
  3614.       send2(CHR$(27)+"q")
  3615.     CASE 3 !Vt52
  3616.     CASE 4 !Ansi
  3617.       send(CHR$(27)+"[m")
  3618.     ENDSELECT
  3619.   ELSE
  3620.     reverse!=TRUE
  3621.     SELECT graphics|
  3622.     CASE 0 !Ascii
  3623.     CASE 1 !VT52 mono
  3624.       send2(CHR$(27)+"p")
  3625.     CASE 2 !VT52 Color
  3626.       send2(CHR$(27)+"p")
  3627.     CASE 3 !Vt52
  3628.     CASE 4 !Ansi
  3629.       send(CHR$(27)+"[7m")
  3630.     ENDSELECT
  3631.   ENDIF
  3632. RETURN
  3633. > PROCEDURE type(type$)                    !Simulated Sysop
  3634.   LOCAL f#,n#                                           ! Just some fun...
  3635.   DIM key#(255)
  3636.   FOR f#=0 TO 255
  3637.     key#(f#)=INT(RND*45)+10
  3638.   NEXT f#
  3639.   FOR n#=1 TO LEN(type$)
  3640.     t#=TIMER+key#(ASC(MID$(type$,n#,1)))
  3641.     REPEAT
  3642.     UNTIL TIMER>t#
  3643.     send(MID$(type$,n#,1))
  3644.     IF MID$(type$,f#,1)=" "
  3645.       t#=TIMER+INT(RND*10)+55
  3646.       REPEAT
  3647.       UNTIL TIMER>t#
  3648.     ENDIF
  3649.   NEXT n#
  3650.   ERASE key#()
  3651. RETURN
  3652. '
  3653. > PROCEDURE chat                           !Very simple chat
  3654.   clr
  3655.   send("wpMinichat.  press Ctrl-c to exit.                                                qv"+cr$)
  3656.   send("Hmm, vad vill "+user$+" nu d}? :-)"+cr$+cr$)
  3657.   REPEAT
  3658.     IF INP?(1)
  3659.       i%=INP(1)
  3660.       send(CHR$(i%))
  3661.       IF i%=13
  3662.         send(CHR$(10))
  3663.       ENDIF
  3664.     ENDIF
  3665.     IF INP?(2)
  3666.       i%=INP(2)
  3667.       IF i%=165
  3668.         send(cr$+"Sysop ha jumped to dos, please wait...")
  3669.         jump_to_dos
  3670.         send(cr$+"Back from dos, Hi again!")
  3671.       ELSE
  3672.         send(CHR$(i%))
  3673.       ENDIF
  3674.       IF i%=13
  3675.         send(CHR$(10))
  3676.       ENDIF
  3677.     ENDIF
  3678.   UNTIL i%=3
  3679.   send(cr$+cr$+"Bye!")
  3680.   send(cr$+cr$+"-- Chat ended, Press return")
  3681. RETURN
  3682. '
  3683. > PROCEDURE get_baud(VAR baud|)            !Get&Set baud (part 1)
  3684.   baud$=""
  3685.   baud|=255
  3686.   get_baud1
  3687.   IF LEN(baud$)=0
  3688.     IF speedlock!
  3689.       baud|=255
  3690.       baud$="???"
  3691.     ELSE
  3692.       get_baud2              ! Couldn't catch 'CONNECT'
  3693.     ENDIF
  3694.   ENDIF
  3695.   IF NOT speedlock!
  3696.     IF baud|<255
  3697.       setbaud(baud|)
  3698.     ENDIF
  3699.   ENDIF
  3700. RETURN
  3701. > PROCEDURE get_baud1                      !Get baud (part 2) (Normal)
  3702.   LOCAL t%,connect$                                    ! Like normal BBS
  3703.   t%=TIMER+1000 !10 Sek
  3704.   REPEAT
  3705.     IF INP?(1)
  3706.       connect$=connect$+CHR$(INP(1))
  3707.       IF INSTR(connect$,"CONNECT"+CHR$(13))           !  300 Baud
  3708.         baud|=9
  3709.         baud$="300"
  3710.       ELSE IF INSTR(connect$,"CONNECT 1200")          ! 1200 Baud
  3711.         baud|=7
  3712.         baud$="1200"
  3713.       ELSE IF INSTR(connect$,"CONNECT 2400")          ! 2400 Baud
  3714.         baud|=4
  3715.         baud$="2400"
  3716.       ELSE IF INSTR(connect$,"CONNECT 9600")
  3717.         baud|=0
  3718.         baud$="9600"
  3719.       ELSE IF LEN(connect$)>15
  3720.         connect$=MID$(connect$,2)
  3721.       ENDIF
  3722.     ENDIF
  3723.   UNTIL TIMER>t% OR baud|<255
  3724. RETURN
  3725. > PROCEDURE get_baud2                      !Get baud (Part 3) (Michtron Style)
  3726.   LOCAL i%,f%,t%                                         ! Like Michtron BBS
  3727.   REPEAT
  3728.     FOR f%=0 TO 9
  3729.       SELECT f%
  3730.       CASE 0,1,2,4,7,9        ! 19200 9600 4800 2400 1200 300
  3731.         setbaud(f%)
  3732.         clr
  3733.         send(cr$+"Press <Return>"+cr$)
  3734.         t%=TIMER+600
  3735.         REPEAT
  3736.           IF INP?(1)
  3737.             i%=INP(1)
  3738.             IF i%=13
  3739.               baud|=f%
  3740.             ENDIF
  3741.           ENDIF
  3742.         UNTIL TIMER>t% OR baud|=>0 OR FN cd=FALSE
  3743.       ENDSELECT
  3744.       EXIT IF FN cd=FALSE OR baud|<255
  3745.     NEXT f%
  3746.   UNTIL FN cd=FALSE OR baud|<255
  3747. RETURN
  3748. > PROCEDURE setbaud(baud|)                 !Set Baud
  3749.   VOID XBIOS(15,W:baud|,W:-1,W:-1,W:-1,W:-1,W:-1)
  3750.   '  Baudrates:
  3751.   ' Input:   gives:
  3752.   '  0 =     19200
  3753.   '  1 =      9600
  3754.   '  2 =      4800
  3755.   '  3 =      3600
  3756.   '  4 =      2400
  3757.   '  5 =      2000
  3758.   '  6 =      1800
  3759.   '  7 =      1200
  3760.   '  8 =       600
  3761.   '  9 =       300
  3762.   ' 10 =       200
  3763.   ' 11 =       150
  3764.   ' 12 =       134
  3765.   ' 13 =       110
  3766.   ' 14 =        75
  3767.   ' 15 =        50
  3768. RETURN
  3769. > PROCEDURE setup_modem                    !Trash
  3770.   setbaud(0)                                          ! most modems can read
  3771.   '  send("ATZ"+CHR$(13))                              ! at 300 baud.
  3772.   ' wait(2)
  3773.   ' send("AT S0=1 "+CHR$(13))             ! I found out, that if
  3774.   ' wait(2)                                             ! you put 3 times plus
  3775.   REPEAT                                              ! before a modemcommand,
  3776.     IF INP?(1)                                        ! then you can be more
  3777.       ~INP(1)                                         ! sure, that it's read.
  3778.     ENDIF
  3779.   UNTIL INP?(1)=FALSE
  3780. RETURN
  3781. '
  3782. > PROCEDURE modem(mcommand$)               !Send modem Commands (Part 1)
  3783.   proc$="modem()"
  3784.   @modem_stat
  3785.   IF dcd!
  3786.     '    PRINT " o Carrier present"
  3787.   ENDIF
  3788.   clear_rs
  3789.   IF @mod(mcommand$)
  3790.     '
  3791.   ELSE
  3792.     PRINT " o Error in Modem Commands"
  3793.   ENDIF
  3794. RETURN
  3795. > PROCEDURE modem_stat                     !Check status of Modem
  3796.   proc$="Modem_stat"
  3797.   LOCAL r%
  3798.   r%=PEEK(&HFFFA01)
  3799.   centronics_busy!=NOT BTST(r%,0)
  3800.   dcd!=NOT BTST(r%,1)
  3801.   cts!=NOT BTST(r%,2)
  3802.   blitter_klar!=NOT BTST(r%,3)
  3803.   ri!=NOT BTST(r%,6)
  3804.   monokrom!=NOT BTST(r%,7)
  3805. RETURN
  3806. > PROCEDURE clear_rs                         !Clear RS232 and keybord Buffers
  3807.   proc$="Clear RS"
  3808.   ii%=3000
  3809.   REPEAT
  3810.     IF INP?(2)
  3811.       ~INP(2)
  3812.     ELSE IF INP?(1)
  3813.       ~INP(1)
  3814.     ENDIF
  3815.     PAUSE ABS(INT(ii%/1000))
  3816.     DEC ii%
  3817.   UNTIL (NOT INP?(1)) AND (NOT INP?(2))
  3818. RETURN
  3819. '
  3820. ' -----------------------------------------< FUNCTIONS
  3821. '
  3822. > FUNCTION mod(a$)                         !Send Modem Commands (Part 2)
  3823.   LOCAL timeout%
  3824.   e!=FALSE
  3825.   proc$="FN mod()"
  3826.   FOR i%=1 TO LEN(a$)
  3827.     a%=ASC(MID$(a$,i%,1))
  3828.     SELECT CHR$(a%)
  3829.     CASE "|"
  3830.       OUT 1,13
  3831.     CASE "^"
  3832.       ~XBIOS(29,NOT 16)
  3833.     CASE "v"
  3834.       ~XBIOS(30,16)
  3835.     CASE "("
  3836.       ~XBIOS(29,NOT 8)
  3837.       timeout%=TIMER
  3838.       REPEAT
  3839.         @modem_stat
  3840.       UNTIL cts! OR ((TIMER-timeout%)>1000)
  3841.       IF NOT cts!
  3842.         e!=TRUE
  3843.       ENDIF
  3844.     CASE ")"
  3845.       ~XBIOS(30,8)
  3846.     CASE "~"
  3847.       PAUSE 50
  3848.       clear_rs
  3849.     CASE "'"
  3850.       PAUSE 10
  3851.     DEFAULT
  3852.       OUT 1,a%
  3853.     ENDSELECT
  3854.   NEXT i%
  3855.   IF e!
  3856.     RETURN FALSE
  3857.   ELSE
  3858.     RETURN TRUE
  3859.   ENDIF
  3860. ENDFUNC
  3861. '
  3862. > FUNCTION enviroment$(string$)            !Search for a Enviroment
  3863.   proc$="FN Enviroment$()"
  3864.   l%=LEN(string$)
  3865.   gotit!=FALSE
  3866.   env%={BASEPAGE+&H2C}
  3867.   DO
  3868.     env$=CHAR{env%}
  3869.     IF LEFT$(env$,l%)=string$
  3870.       env$=MID$(env$,l%+1)
  3871.       gotit!=TRUE
  3872.     ENDIF
  3873.     EXIT IF LEN(env$)=0 OR gotit!
  3874.     ADD env%,SUCC(LEN(env$))
  3875.   LOOP
  3876.   IF NOT gotit!
  3877.     env$=CHR$(GEMDOS(25)+65)+":"+DIR$(0)+"\"
  3878.   ELSE IF RIGHT$(env$)<>"\"
  3879.     env$=env$+"\"
  3880.   ENDIF
  3881.   RETURN env$
  3882. ENDFUNC
  3883. '
  3884. > FUNCTION newuser(usr$)                   !Search for a User
  3885.   l%=@init_userfile(99)
  3886.   IF l%
  3887.     FOR f%=1 TO l%
  3888.       GET #99
  3889.       IF UPPER$(usr$)=UPPER$(CHAR{V:u.user$})
  3890.         RETURN f%
  3891.       ELSE IF UPPER$(usr$)=UPPER$(CHAR{V:u.alias$})
  3892.         RETURN f%
  3893.       ENDIF
  3894.     NEXT f%
  3895.   ENDIF
  3896.   RETURN FALSE
  3897. ENDFUNC
  3898. > FUNCTION init_userfile(channel%)         !Init Userfile
  3899.   CLOSE #channel%
  3900.   OPEN "R",#channel%,scs$+"CONF\BBS.USR",150
  3901.   FIELD #channel%,36 AS u.user$,16 AS u.city$,16 AS u.alias$,16 AS u.pass$
  3902.   FIELD #channel%,16 AS u.phone$,4 AS u.last_time$,6 AS u.last_date$
  3903.   FIELD #channel%,1 AT(*u.attribut|),1 AT(*u.screenlenght|),4 AT(*u.flags%)
  3904.   FIELD #channel%,2 AT(*u.credit&),2 AT(*u.posted_msgs&),1 AT(*u.graphics|)
  3905.   FIELD #channel%,1 AT(*u.level|),2 AT(*u.calls&),2 AT(*u.uploads&)
  3906.   FIELD #channel%,2 AT(*u.downloads&),2 AT(*u.upl_kb&),2 AT(*u.down_kb&)
  3907.   FIELD #channel%,2 AT(*u.down_today&),2 AT(*u.minutes_today&)
  3908.   FIELD #channel%,2 AT(*u.lastfile%),2 AT(*u.lastmsg&),1 AT(*u.charset|)
  3909.   FIELD #channel%,9 AS reserv$
  3910.   RETURN LOF(#channel%)/150
  3911. ENDFUNC
  3912. > FUNCTION init_t.userfile(channel%)       !Dito (For useredit)
  3913.   CLOSE #channel%
  3914.   OPEN "R",#channel%,scs$+"CONF\BBS.USR",150
  3915.   FIELD #channel%,36 AS tu.user$,16 AS tu.city$,16 AS tu.alias$,16 AS tu.pass$
  3916.   FIELD #channel%,16 AS tu.phone$,4 AS tu.last_time$,6 AS tu.last_date$
  3917.   FIELD #channel%,1 AT(*tu.attribut|),1 AT(*tu.screenlenght|),4 AT(*tu.flags%)
  3918.   FIELD #channel%,2 AT(*tu.credit&),2 AT(*tu.posted_msgs&),1 AT(*tu.graphics|)
  3919.   FIELD #channel%,1 AT(*tu.level|),2 AT(*tu.calls&),2 AT(*tu.uploads&)
  3920.   FIELD #channel%,2 AT(*tu.downloads&),2 AT(*tu.upl_kb&),2 AT(*tu.down_kb&)
  3921.   FIELD #channel%,2 AT(*tu.down_today&),2 AT(*tu.minutes_today&)
  3922.   FIELD #channel%,2 AT(*tu.lastfile%),2 AT(*tu.lastmsg&),1 AT(*tu.charset|)
  3923.   FIELD #channel%,9 AS reserv$
  3924.   RETURN LOF(#channel%)/150
  3925. ENDFUNC
  3926. '
  3927. > FUNCTION init_files.dat(path$)           !Init files.dat
  3928.   CLOSE #16
  3929.   OPEN "R",#16,path$+"FILES.DAT",54
  3930.   FIELD #16,36 AS f.fuploader$,13 AS f.ffilename$,2 AT(*f.fcounter&)
  3931.   FIELD #16,2 AT(*f.fnumber&),1 AT(*f.fdelete|)
  3932.   RETURN LOF(#16)/54
  3933. ENDFUNC
  3934. '
  3935. > FUNCTION run(prg$,cmd$)                  !Execute a program
  3936.   proc$="FN Run()"
  3937.   '
  3938.   ' env$="SHELL="+shell$+CHR$(0)                    ! Create QBBS variable
  3939.   ' env$=env$+"TMP=A:\"
  3940.   ' env$=env$+"MAILER=B:\MAILER\"+MKI$(0)               ! Create TB variable
  3941.   '
  3942.   env$=@get_env$
  3943.   cmd$=CHR$(LEN(cmd$))+cmd$+CHR$(0)
  3944.   '
  3945.   RESERVE 16384                                ! Shrink heap
  3946.   ' e%=GEMDOS(75,W:0,L:V:prg$,L:V:cmd$,L:V:env$)  ! Run program
  3947.   e%=EXEC(0,prg$,cmd$,env$)
  3948.   RESERVE                                       ! Restore heap
  3949.   '
  3950.   RETURN e%
  3951. ENDFUNC
  3952. > FUNCTION get_env$
  3953.   proc$="FN Enviroment$()"
  3954.   LOCAL e$,env%
  3955.   env$=""
  3956.   env%={BASEPAGE+&H2C}
  3957.   DO
  3958.     e$=CHAR{env%}
  3959.     env$=env$+e$+CHR$(0)
  3960.     EXIT IF LEN(e$)=0
  3961.     ADD env%,SUCC(LEN(e$))
  3962.   LOOP
  3963.   RETURN env$+CHR$(0)
  3964. ENDFUNC
  3965. '
  3966. > FUNCTION cwd$                            !Return Current Work Dir
  3967.   a$=CHR$(GEMDOS(&H19)+65)+":"
  3968.   a$=a$+DIR$(0)+"\"
  3969.   RETURN a$
  3970. ENDFUNC
  3971. > FUNCTION chd(a$)                         !Change Dir
  3972.   IF MID$(a$,2,1)=":"
  3973.     CHDRIVE LEFT$(a$)
  3974.     a$=MID$(a$,3)
  3975.   ENDIF
  3976.   IF RIGHT$(a$)="\"
  3977.     a$=LEFT$(a$,LEN(a$)-1)
  3978.   ENDIF
  3979.   CHDIR a$
  3980.   RETURN 0
  3981. ENDFUNC
  3982. '
  3983. > FUNCTION files$(path$)                   !Get size&Date for files.bbs
  3984.   LOCAL t%,t$,d%,namn$
  3985.   '
  3986.   ~FSETDTA(BASEPAGE+128)
  3987.   e%=FSFIRST(path$,-1)
  3988.   DO UNTIL e%
  3989.     a|=PEEK(BASEPAGE+128+21)     !Attribut
  3990.     IF (NOT BTST(a|,1)) AND (NOT BTST(a|,2)) AND (NOT BTST(a|,3)) AND (NOT BTST(a|,4))
  3991.       size$=STR$({BASEPAGE+128+26})!Size
  3992.       size$=SPACE$(7-LEN(size$))+size$+" "
  3993.       '
  3994.       d%=DPEEK(BASEPAGE+128+24)    !Date
  3995.       d$=" "+STR$(d% DIV 512+80)
  3996.       d$=d$+RIGHT$("0"+STR$(d%/32 AND 15),2)
  3997.       d$=d$+RIGHT$("0"+STR$(d% AND 31),2)
  3998.       '
  3999.       RETURN size$+d$+" "+@fcount$(path$)
  4000.     ENDIF
  4001.     e%=FSNEXT()
  4002.   LOOP
  4003.   IF e%=-33
  4004.     RETURN " - -  On  Disk  - - "
  4005.   ELSE
  4006.     RETURN ""
  4007.   ENDIF
  4008. ENDFUNC
  4009. > FUNCTION fcount$(path$)                  !Read Filecount
  4010.   fcount&=0
  4011.   FOR i%=1 TO lfd%
  4012.     get_files.dat(i%)
  4013.     EXIT IF (ffilename$=file$)
  4014.   NEXT i%
  4015.   c$=STRING$(3-LEN(STR$(fcounter&)),"0")+STR$(fcounter&)+" "
  4016.   RETURN c$
  4017. ENDFUNC
  4018. > FUNCTION update_fcount(path$)            !Update Filecounter
  4019.   REPEAT
  4020.     IF INSTR(path$," ")
  4021.       file$=TRIM$(LEFT$(path$,INSTR(path$," ")))
  4022.       path$=TRIM$(MID$(path$,INSTR(path$," ")))
  4023.     ELSE
  4024.       file$=TRIM$(path$)
  4025.       path$=""
  4026.     ENDIF
  4027.     FOR i%=1 TO lfd%
  4028.       get_files.dat(i%)
  4029.       IF (ffilename$=file$)
  4030.         INC fcounter&
  4031.         put_files.dat(i%)
  4032.         i%=lfd%
  4033.         '
  4034.         INC downloads&
  4035.       ENDIF
  4036.     NEXT i%
  4037.     IF i%=lfd%+1
  4038.       fuploader$="Sysop"
  4039.       ffilename$=file$
  4040.       fcounter&=1
  4041.       INC lfd%
  4042.       fnumber&=lfd%
  4043.       fdelete|=0
  4044.       INC fcounter&
  4045.       put_files.dat(lfd%)
  4046.       '
  4047.       INC downloads&
  4048.     ENDIF
  4049.   UNTIL path$=""
  4050.   RETURN 0
  4051. ENDFUNC
  4052. > FUNCTION file_wrap$(a$)                  !Wrap Files.bbs
  4053.   LOCAL b$
  4054.   REPEAT
  4055.     IF LEN(a$)>80
  4056.       b$=b$+LEFT$(a$,RINSTR(a$," ",80))+cr$
  4057.       a$=SPACE$(33)+MID$(a$,RINSTR(a$," ",80))
  4058.     ELSE
  4059.       b$=b$+a$
  4060.       a$=""
  4061.     ENDIF
  4062.   UNTIL a$=""
  4063.   RETURN b$
  4064. ENDFUNC
  4065. > FUNCTION find_file$(path$,batch!)        !Get size&Date for files.bbs
  4066.   LOCAL t%,t$,d%,namn$,s%
  4067.   '
  4068.   a$=""
  4069.   ~FSETDTA(BASEPAGE+128)
  4070.   e%=FSFIRST(path$,-1)
  4071.   DO UNTIL e%
  4072.     a|=PEEK(BASEPAGE+128+21)     !Attribut
  4073.     IF (NOT BTST(a|,1)) AND (NOT BTST(a|,2)) AND (NOT BTST(a|,3)) AND (NOT BTST(a|,4))
  4074.       namn$=CHAR{BASEPAGE+158}
  4075.       a$=a$+" "+namn$
  4076.       s$=STR$({BASEPAGE+128+26})!Size
  4077.       ADD s%,VAL(s$)
  4078.       EXIT IF NOT batch!
  4079.     ENDIF
  4080.     e%=FSNEXT()
  4081.   LOOP
  4082.   RETURN STR$(s%)+" "+a$
  4083. ENDFUNC
  4084. '
  4085. > FUNCTION gmts                            !Return no secounds since 1/1 1970
  4086.   proc$="FN gmts"
  4087.   LOCAL t%,d$,t$
  4088.   t%=599616000
  4089.   ' 1 jan 89 0:00:00
  4090.   d$=DATE$
  4091.   t$=TIME$
  4092.   ADD t%,3.1536E+07*(VAL(MID$(d$,9,2))-89)
  4093.   ADD t%,mnds%(VAL(MID$(d$,4,2)))
  4094.   ADD t%,86400*(VAL(d$)-1)
  4095.   ADD t%,3600*VAL(t$)
  4096.   ADD t%,60*VAL(MID$(t$,4,2))
  4097.   ADD t%,VAL(MID$(t$,7,2))
  4098.   '
  4099.   ' correctie voor schrikkeljaar 1990
  4100.   ' tegen 1994 wordt dit prg toch niet meer gebruikt :-)
  4101.   IF VAL(MID$(d$,9,2))>=90 AND VAL(MID$(d$,4,2))>=3
  4102.     ADD t%,86400
  4103.   ENDIF
  4104.   '
  4105.   RETURN t%
  4106. ENDFUNC
  4107. > FUNCTION dates$                          !Return Date-Field for MSGS
  4108.   proc$="FN Date$"
  4109.   a$=""
  4110.   a$=LEFT$(DATE$,2)+" "
  4111.   a$=a$+mnd$(VAL(MID$(DATE$,4,2)))+" "
  4112.   a$=a$+RIGHT$(DATE$,2)+" "
  4113.   a$=a$+TIME$
  4114.   RETURN a$
  4115. ENDFUNC
  4116. > FUNCTION read_msgs$(offset%,size&)       !Read in a MSG-Text
  4117.   proc$="FN Read_MSG$()"
  4118.   OPEN "I",#1,msg_path$+area_name$+".MSG"
  4119.   SEEK #1,offset%
  4120.   indata$=INPUT$(size&,#1)
  4121.   indata$=LEFT$(indata$,LEN(indata$)-1)
  4122.   CLOSE #1
  4123.   RETURN indata$
  4124. ENDFUNC
  4125. > FUNCTION dfree(drive$)                   !Return freespace in array free%()
  4126.   IF drive$=""
  4127.     free%(0)=MALLOC(-1)
  4128.     a%=BIOS(10)
  4129.     free%(1)=INT(DFREE(1)/1024)
  4130.     free%(2)=-1
  4131.     FOR i%=2 TO 15
  4132.       IF BTST(a%,i%)
  4133.         free%(i%+1)=INT(DFREE(i%+1)/1024)
  4134.       ELSE
  4135.         free%(i%+1)=-1
  4136.       ENDIF
  4137.     NEXT i%
  4138.     RETURN 0
  4139.   ELSE
  4140.     RETURN DFREE(ASC(drive$)-64)
  4141.   ENDIF
  4142. ENDFUNC
  4143. > FUNCTION timeleft                        !Return timeleft
  4144.   RETURN 30
  4145. ENDFUNC
  4146.